diff options
Diffstat (limited to 'tests/winfo.test')
| -rw-r--r-- | tests/winfo.test | 102 |
1 files changed, 58 insertions, 44 deletions
diff --git a/tests/winfo.test b/tests/winfo.test index 826d1e2..82bc261 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -3,14 +3,13 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winfo.test,v 1.3 1998/09/14 18:23:54 stanton Exp $ +# RCS: @(#) $Id: winfo.test,v 1.4 1999/04/16 01:51:44 stanton Exp $ -if {[info procs test] != "test"} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [winfo children .] { @@ -19,6 +18,10 @@ foreach i [winfo children .] { wm geometry . {} raise . +# Some tests require the testwrapper command +set ::tcltest::testConfig(testwrapper) \ + [expr {[info commands testwrapper] != {}}] + # eatColors -- # Creates a toplevel window and allocates enough colors in it to # use up all the slots in the colormap. @@ -88,32 +91,33 @@ test winfo-2.7 {"winfo atom" command} { winfo atomname -displayof . 2 } SECONDARY -if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} { - test winfo-3.1 {"winfo colormapfull" command} { - list [catch {winfo colormapfull} msg] $msg - } {1 {wrong # args: should be "winfo colormapfull window"}} - test winfo-3.2 {"winfo colormapfull" command} { - list [catch {winfo colormapfull a b} msg] $msg - } {1 {wrong # args: should be "winfo colormapfull window"}} - test winfo-3.3 {"winfo colormapfull" command} { - list [catch {winfo colormapfull foo} msg] $msg - } {1 {bad window path name "foo"}} - test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} { - eatColors .t {-colormap new} - set result [list [winfo colormapfull .] [winfo colormapfull .t]] - .t.c delete 34 - lappend result [winfo colormapfull .t] - .t.c create rectangle 30 30 80 80 -fill #441739 - lappend result [winfo colormapfull .t] - .t.c create rectangle 40 40 90 90 -fill #ffeedd - lappend result [winfo colormapfull .t] - destroy .t.c - lappend result [winfo colormapfull .t] - } {0 1 0 0 1 0} - catch {destroy .t} -} +# Some tests require the "pseudocolor" visual class. +set ::tcltest::testConfig(pseudocolor) \ + [expr {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")}] +test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull} msg] $msg +} {1 {wrong # args: should be "winfo colormapfull window"}} +test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull a b} msg] $msg +} {1 {wrong # args: should be "winfo colormapfull window"}} +test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} { + list [catch {winfo colormapfull foo} msg] $msg +} {1 {bad window path name "foo"}} +test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} { + eatColors .t {-colormap new} + set result [list [winfo colormapfull .] [winfo colormapfull .t]] + .t.c delete 34 + lappend result [winfo colormapfull .t] + .t.c create rectangle 30 30 80 80 -fill #441739 + lappend result [winfo colormapfull .t] + .t.c create rectangle 40 40 90 90 -fill #ffeedd + lappend result [winfo colormapfull .t] + destroy .t.c + lappend result [winfo colormapfull .t] +} {0 1 0 0 1 0} catch {destroy .t} + toplevel .t -width 550 -height 400 frame .t.f -width 80 -height 60 -bd 2 -relief raised place .t.f -x 50 -y 50 @@ -206,15 +210,9 @@ test winfo-7.6 {"winfo pathname" command} { test winfo-7.7 {"winfo pathname" command} { winfo pathname -displayof .b [winfo id .] } {.} - -if {[string compare testwrapper [info commands testwrapper]] == 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - - test winfo-7.8 {"winfo pathname" command} {unixOnly} { - winfo pathname [testwrapper .] - } {} -} +test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} { + winfo pathname [testwrapper .] +} {} test winfo-8.1 {"winfo pointerx" command} { catch [winfo pointerx .b] @@ -317,7 +315,7 @@ proc MakeEmbed {} { pack .emb.b -expand yes -fill both update } -test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} { +test winfo-13.1 {root coordinates of embedded toplevel} { MakeEmbed set z [expr [winfo rootx .emb] == [winfo rootx .con] && \ [winfo rooty .emb] == [winfo rooty .con]] @@ -325,8 +323,8 @@ test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} { destroy .con set z } {1} -test winfo-13.2 {destroying embedded toplevel} {macOrUnix} { - catch {destroy .emb} +test winfo-13.2 {destroying embedded toplevel} { + destroy .emb update expr [winfo exists .emb.b] || [winfo exists .con] } 0 @@ -335,7 +333,7 @@ foreach i [winfo children .] { destroy $i } -test winfo-13.3 {destroying container window} {macOrUnix} { +test winfo-13.3 {destroying container window} { MakeEmbed destroy .con update @@ -349,7 +347,7 @@ foreach i [winfo children .] { destroy $i } -test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} { +test winfo-13.4 {[winfo containing] with embedded windows} { MakeEmbed button .b pack .b -expand yes -fill both @@ -365,3 +363,19 @@ test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} { foreach i [winfo children .] { catch {destroy $i} } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + |