diff options
Diffstat (limited to 'tk8.6/tests/unixEmbed.test')
| -rw-r--r-- | tk8.6/tests/unixEmbed.test | 717 |
1 files changed, 0 insertions, 717 deletions
diff --git a/tk8.6/tests/unixEmbed.test b/tk8.6/tests/unixEmbed.test deleted file mode 100644 index 8aaa3c4..0000000 --- a/tk8.6/tests/unixEmbed.test +++ /dev/null @@ -1,717 +0,0 @@ -# This file is a Tcl script to test out the procedures in the file -# tkUnixEmbed.c. It is organized in the standard fashion for Tcl -# tests. -# -# Copyright (c) 1996-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. - -package require tcltest 2.2 -eval tcltest::configure $argv -tcltest::loadTestedCommands -namespace import -force tcltest::test - -setupbg -dobg {wm withdraw .} - -# eatColors -- -# Creates a toplevel window and allocates enough colors in it to -# use up all the slots in the colormap. -# -# Arguments: -# w - Name of toplevel window to create. - -proc eatColors {w} { - catch {destroy $w} - toplevel $w - wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 - pack $w.c - for {set y 0} {$y < 8} {incr y} { - for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ - -fill $color - } - } - update -} - -# colorsFree -- -# -# Returns 1 if there appear to be free colormap entries in a window, -# 0 otherwise. -# -# Arguments: -# w - Name of window in which to check. -# red, green, blue - Intensities to use in a trial color allocation -# to see if there are colormap entries free. - -proc colorsFree {w {red 31} {green 245} {blue 192}} { - set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] - expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) -} - -test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} -constraints { - unix -} -setup { - deleteWindows -} -body { - toplevel .t -use xyz -} -returnCodes error -result {expected integer but got "xyz"} -test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} -constraints { - unix -} -setup { - deleteWindows -} -body { - toplevel .t -use 47 -} -returnCodes error -result {couldn't create child of window "47"} -test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} -constraints { - unix nonPortable -} -setup { - deleteWindows -} -body { - toplevel .t -colormap new - wm geometry .t +0+0 - eatColors .t.t - frame .t.f -container 1 - toplevel .x -use [winfo id .t.f] - colorsFree .x -} -cleanup { - deleteWindows -} -result {0} -test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} -constraints { - unix nonPortable -} -setup { - deleteWindows -} -body { - toplevel .t -container 1 -colormap new - wm geometry .t +0+0 - eatColors .t2 - toplevel .x -use [winfo id .t] - colorsFree .x -} -cleanup { - deleteWindows -} -result {1} - -test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -container 1 -width 200 -height 50 - pack .f1 .f2 - dobg "set w [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t -use $w - list [testembed] [expr [lindex [lindex [testembed all] 0] 0] - $w] - } -} -cleanup { - deleteWindows -} -result {{{XXX {} {} .t}} 0} -test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -container 1 -width 200 -height 50 - pack .f1 .f2 - dobg "set w1 [winfo id .f1]" - dobg "set w2 [winfo id .f2]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - toplevel .t2 -use $w2 - testembed - } -} -cleanup { - deleteWindows -} -result {{XXX {} {} .t2} {XXX {} {} .t1}} -test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -container 1 -width 200 -height 50 - pack .f1 .f2 - toplevel .t1 -use [winfo id .f1] - toplevel .t2 -use [winfo id .f2] - testembed -} -cleanup { - deleteWindows -} -result {{XXX .f2 {} .t2} {XXX .f1 {} .t1}} - -# Can't think of any way to test the procedures TkpMakeWindow, -# TkpMakeContainer, or EmbedErrorProc. - - -test unixEmbed-2.1 {EmbeddedEventProc procedure} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - testembed - } - destroy .f1 - update - dobg { - testembed - } -} -cleanup { - deleteWindows -} -result {} -test unixEmbed-2.2 {EmbeddedEventProc procedure} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - testembed - destroy .t1 - testembed - } -} -cleanup { - deleteWindows -} -result {} -test unixEmbed-2.3 {EmbeddedEventProc procedure} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - toplevel .t1 -use [winfo id .f1] - update - destroy .f1 - testembed -} -result {} -test unixEmbed-2.4 {EmbeddedEventProc procedure} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - toplevel .t1 -use [winfo id .f1] - update - destroy .t1 - set x [testembed] - update - list $x [testembed] -} -cleanup { - deleteWindows -} -result {{{XXX .f1 {} {}}} {}} - - -test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} -constraints { - unix testembed nonPortable -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - set x [testembed] - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - wm withdraw .t1 - } - list $x [testembed] -} -cleanup { - deleteWindows -} -result {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}} -test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} -constraints { - unix -} -setup { - deleteWindows -} -body { - toplevel .t1 -container 1 - wm geometry .t1 +0+0 - toplevel .t2 -use [winfo id .t1] -bg red - update - wm geometry .t2 -} -cleanup { - deleteWindows -} -result {200x200+0+0} -test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -bd 2 -relief raised - update - wm geometry .t1 +30+40 - } - update - dobg { - wm geometry .t1 - } -} -cleanup { - deleteWindows -} -result {200x200+0+0} -test unixEmbed-3.4 {ContainerEventProc procedure, disallow position changes} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - update - wm geometry .t1 300x100+30+40 - } - update - dobg { - wm geometry .t1 - } -} -cleanup { - deleteWindows -} -result {300x100+0+0} -test unixEmbed-3.5 {ContainerEventProc procedure, geometry requests} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - dobg { - .t1 configure -width 300 -height 80 - } - update - list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}] -} -cleanup { - deleteWindows -} -result {300 80 300x80+0+0} -test unixEmbed-3.6 {ContainerEventProc procedure, map requests} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - set x unmapped - bind .t1 <Map> {set x mapped} - } - update - dobg { - after 100 - update - set x - } -} -cleanup { - deleteWindows -} -result {mapped} -test unixEmbed-3.7 {ContainerEventProc procedure, destroy events} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - bind .f1 <Destroy> {set x dead} - set x alive - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - dobg { - destroy .t1 - } - update - list $x [winfo exists .f1] -} -cleanup { - deleteWindows -} -result {dead 0} - - -test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - dobg { - .t1 configure -width 180 -height 100 - } - update - dobg { - winfo geometry .t1 - } -} -cleanup { - deleteWindows -} -result {180x100+0+0} -test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - set x [testembed] - destroy .f1 - list $x [testembed] -} -cleanup { - deleteWindows -} -result {{{XXX .f1 XXX {}}} {}} - - -test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - bind .t1 <FocusIn> {lappend x "focus in %W"} - bind .t1 <FocusOut> {lappend x "focus out %W"} - set x {} - } - focus -force .f1 - update - dobg {set x} -} -cleanup { - deleteWindows -} -result {{focus in .t1}} -test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - dobg { - after 200 {destroy .t1} - } - after 400 - focus -force .f1 - update -} -cleanup { - deleteWindows -} -result {} -test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - bind .t1 <FocusIn> {lappend x "focus in %W"} - bind .t1 <FocusOut> {lappend x "focus out %W"} - set x {} - } - focus -force .f1 - update - set x [dobg {update; set x}] - focus . - update - list $x [dobg {update; set x}] -} -cleanup { - deleteWindows -} -result {{{focus in .t1}} {{focus in .t1} {focus out .t1}}} - - -test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - dobg { - bind .t1 <Configure> {lappend x {configure .t1 %w %h}} - set x {} - .t1 configure -width 300 -height 120 - update - list $x [winfo geom .t1] - } -} -cleanup { - deleteWindows -} -result {{{configure .t1 300 120}} 300x120+0+0} -test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - place .f1 -width 200 -height 200 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - after 300 {set x done} - vwait x - dobg { - bind .t1 <Configure> {lappend x {configure .t1 %w %h}} - set x {} - .t1 configure -width 300 -height 120 - update - list $x [winfo geom .t1] - } -} -cleanup { - deleteWindows -} -result {{{configure .t1 200 200}} 200x200+0+0} - -# Can't think up any tests for TkpGetOtherWindow procedure. - - -test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} -constraints { - unix -} -setup { - deleteWindows -} -body { - deleteWindows - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - focus -force . - bind . <KeyPress> {lappend x {key %A %E}} - set x {} - set y [dobg { - update - bind .t1 <KeyPress> {lappend y {key %A}} - set y {} - event generate .t1 <KeyPress> -keysym a - set y - }] - update - list $x $y -} -cleanup { - deleteWindows - bind . <KeyPress> {} -} -result {{{key a 1}} {}} -test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - } - update - focus -force .f1 - update - bind . <KeyPress> {lappend x {key %A}} - set x {} - set y [dobg { - update - bind .t1 <KeyPress> {lappend y {key %A}} - set y {} - event generate .t1 <KeyPress> -keysym b - set y - }] - update - list $x $y -} -cleanup { - deleteWindows - bind . <KeyPress> {} -} -result {{} {{key b}}} - - -test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -width 200 -height 50 - pack .f1 .f2 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken - } - focus -force .f2 - update - list [dobg { - focus .t1 - set x [list [focus]] - update - after 500 - update - lappend x [focus] - }] [focus] -} -cleanup { - deleteWindows -} -result {{{} .t1} .f1} -test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup { - deleteWindows - catch {interp delete child} - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -width 200 -height 50 - pack .f1 .f2 - interp create child - child eval "set argv {-use [winfo id .f1]}" - load {} Tk child - child eval { - . configure -bd 2 -highlightthickness 2 -relief sunken - } - focus -force .f2 - update - list [child eval { - focus . - set x [list [focus]] - update - lappend x [focus] - }] [focus] -} -cleanup { - deleteWindows -} -result {{{} .} .f1} -catch {interp delete child} - - -test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - frame .f2 -container 1 -width 200 -height 50 - frame .f3 -container 1 -width 200 -height 50 - frame .f4 -container 1 -width 200 -height 50 - pack .f1 .f2 .f3 .f4 - set x {} - lappend x [testembed] - foreach w {.f3 .f4 .f1 .f2} { - destroy $w - lappend x [testembed] - } - set x -} -cleanup { - deleteWindows -} -result {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} -test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraints { - unix testembed -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - dobg "set w1 [winfo id .f1]" - dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken - set x {} - lappend x [testembed] - destroy .t1 - lappend x [testembed] - } -} -cleanup { - deleteWindows -} -result {{{XXX {} {} .t1}} {}} - - -test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - toplevel .t1 -use [winfo id .f1] -width 150 -height 80 - update - wm geometry .t1 +40+50 - update - wm geometry .t1 -} -cleanup { - deleteWindows -} -result {150x80+0+0} -test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints { - unix -} -setup { - deleteWindows -} -body { - frame .f1 -container 1 -width 200 -height 50 - pack .f1 - toplevel .t1 -use [winfo id .f1] -width 150 -height 80 - update - wm geometry .t1 70x300+10+20 - update - wm geometry .t1 -} -cleanup { - deleteWindows -} -result {70x300+0+0} - -# cleanup -deleteWindows -cleanupbg -cleanupTests -return - |