tk/tests/macEmbed.test

   1 # This file is a Tcl script to test out the procedures in the file
   2 # tkMacEmbed.c.  It is organized in the standard fashion for Tcl
   3 # tests.
   4 #
   5 # Copyright (c) 1997 Sun Microsystems, Inc.
   6 # Copyright (c) 1998-1999 by Scriptics Corporation.
   7 # All rights reserved.
   8 #
   9 # RCS: @(#) $Id$
  10
  11 package require tcltest 2.1
  12 namespace import -force tcltest::configure
  13 namespace import -force tcltest::testsDirectory
  14 configure -testdir [file join [pwd] [file dirname [info script]]]
  15 configure -loadfile [file join [testsDirectory] constraints.tcl]
  16 tcltest::loadTestedCommands
  17
  18 test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
  19     catch {destroy .t}
  20     list [catch {toplevel .t -use xyz} msg] $msg
  21 } {1 {expected integer but got "xyz"}}
  22 test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
  23     catch {destroy .t}
  24     list [catch {toplevel .t -use 47} msg] $msg
  25 } {1 {The window ID 47 does not correspond to a valid Tk Window.}}
  26
  27 test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
  28     deleteWindows
  29     frame .f1 -container 1 -width 200 -height 50
  30     frame .f2 -container 1 -width 200 -height 50
  31     pack .f1 .f2
  32     set w [winfo id .f1]
  33         toplevel .t -use $w
  34         list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
  35 } {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
  36 test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
  37     deleteWindows
  38     frame .f1 -container 1 -width 200 -height 50
  39     frame .f2 -container 1 -width 200 -height 50
  40     pack .f1 .f2
  41     set w1 [winfo id .f1]
  42     set w2 [winfo id .f2]
  43         toplevel .t1 -use $w1
  44         toplevel .t2 -use $w2
  45         testembed
  46 } {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}
  47
  48 # Can't think of any way to test the procedures TkpMakeWindow,
  49 # TkpMakeContainer, or EmbedErrorProc.
  50
  51 test macEmbed-2.1 {EmbeddedEventProc procedure} {testembed macOnly} {
  52     deleteWindows
  53     frame .f1 -container 1 -width 200 -height 50
  54     pack .f1
  55     set w1 [winfo id .f1]
  56         toplevel .t1 -use $w1
  57         testembed
  58     destroy .t1
  59     update
  60         testembed
  61 } {}
  62 test macEmbed-2.2 {EmbeddedEventProc procedure} {testembed macOnly} {
  63     deleteWindows
  64     frame .f1 -container 1 -width 200 -height 50
  65     pack .f1
  66     toplevel .t1 -use [winfo id .f1]
  67     update
  68     destroy .f1
  69     testembed
  70 } {}
  71 test macEmbed-2.3 {EmbeddedEventProc procedure} {testembed macOnly} {
  72     deleteWindows
  73     frame .f1 -container 1 -width 200 -height 50
  74     pack .f1
  75     toplevel .t1 -use [winfo id .f1]
  76     update
  77     destroy .t1
  78     update
  79     list [testembed] [winfo children .]
  80 } {{} {}}
  81
  82 test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {testembed macOnly} {
  83     deleteWindows
  84     frame .f1 -container 1 -width 200 -height 50
  85     pack .f1
  86     set w1 [winfo id .f1]
  87     set x [testembed]
  88         toplevel .t1 -use $w1
  89         wm withdraw .t1
  90     list $x [testembed]
  91 } {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
  92 test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
  93         {macOnly} {
  94     deleteWindows
  95     frame .f1 -container 1 -width 200 -height 50
  96     pack .f1
  97     set w1 [winfo id .f1]
  98         toplevel .t1 -use $w1 -bd 2 -relief raised
  99         update
 100         wm geometry .t1 +30+40
 101     update
 102         wm geometry .t1
 103 } {200x200+0+0}
 104 test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
 105         {macOnly} {
 106     deleteWindows
 107     frame .f1 -container 1 -width 200 -height 50
 108     pack .f1
 109     set w1 [winfo id .f1]
 110         toplevel .t1 -use $w1
 111         update
 112         wm geometry .t1 300x100+30+40
 113     update
 114         wm geometry .t1
 115 } {300x100+0+0}
 116 test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
 117     deleteWindows
 118     toplevel .t1 -container 1 -width 200 -height 50
 119     set w1 [winfo id .t1]
 120         toplevel .t2 -use $w1
 121     update
 122         .t1 configure -width 300 -height 80
 123     update
 124     list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
 125 } {300 80 300x80+0+0}
 126 test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
 127     deleteWindows
 128     frame .f1 -container 1 -width 200 -height 50
 129     pack .f1
 130     set w1 [winfo id .f1]
 131         toplevel .t1 -use $w1
 132         set x unmapped
 133         bind .t1 <Map> {set x mapped}
 134     update
 135         after 100
 136         update
 137         set x
 138 } {mapped}
 139 test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
 140     deleteWindows
 141     frame .f1 -container 1 -width 200 -height 50
 142     pack .f1
 143     set w1 [winfo id .f1]
 144     bind .f1 <Destroy> {set x dead}
 145     set x alive
 146         toplevel .t1 -use $w1
 147     update
 148         destroy .t1
 149     update
 150     list $x [winfo exists .f1]
 151 } {dead 0}
 152
 153 test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
 154     deleteWindows
 155     frame .f1 -container 1 -width 200 -height 50
 156     pack .f1
 157     set w1 [winfo id .f1]
 158         toplevel .t1 -use $w1
 159     update
 160         .t1 configure -width 180 -height 100
 161     update
 162         winfo geometry .t1
 163 } {180x100+0+0}
 164 test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {testembed macOnly} {
 165     deleteWindows
 166     frame .f1 -container 1 -width 200 -height 50
 167     pack .f1
 168     set w1 [winfo id .f1]
 169         toplevel .t1 -use $w1
 170     update
 171     set x [testembed]
 172     destroy .f1
 173     list $x [testembed]
 174 } {{{XXX .f1 XXX .t1}} {}}
 175
 176 # Can't think up any tests for TkpGetOtherWindow procedure.
 177
 178 test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
 179     catch {interp delete child}
 180     deleteWindows
 181     frame .f1 -container 1 -width 200 -height 50
 182     frame .f2 -width 200 -height 50
 183     pack .f1 .f2
 184     interp create child
 185     child eval "set argv {-use [winfo id .f1]}"
 186     load {} Tk child
 187     child eval {
 188         . configure -bd 2 -highlightthickness 2 -relief sunken
 189     }
 190     focus -force .f2
 191     update
 192     list [child eval {
 193         focus .
 194         set x [list [focus]]
 195         update
 196         lappend x [focus]
 197     }] [focus]
 198 } {{{} .} .f1}
 199 catch {interp delete child}
 200
 201 test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {testembed macOnly} {
 202     deleteWindows
 203     frame .f1 -container 1 -width 200 -height 50
 204     frame .f2 -container 1 -width 200 -height 50
 205     frame .f3 -container 1 -width 200 -height 50
 206     frame .f4 -container 1 -width 200 -height 50
 207     pack .f1 .f2 .f3 .f4
 208     set x {}
 209     lappend x [testembed]
 210     foreach w {.f3 .f4 .f1 .f2} {
 211         destroy $w
 212         lappend x [testembed]
 213     }
 214     set x
 215 } {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
 216 test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {testembed macOnly} {
 217     deleteWindows
 218     frame .f1 -container 1 -width 200 -height 50
 219     pack .f1
 220     set w1 [winfo id .f1]
 221         toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
 222         set x {}
 223         lappend x [testembed]
 224         destroy .t1
 225         update
 226         lappend x [testembed]
 227 } {{{XXX .f1 XXX .t1}} {}}
 228
 229 test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
 230     deleteWindows
 231     frame .f1 -container 1 -width 200 -height 50
 232     pack .f1
 233     toplevel .t1 -use [winfo id .f1] -width 150 -height 80
 234     update
 235     wm geometry .t1 +40+50
 236     update
 237     wm geometry .t1
 238 } {150x80+0+0}
 239 test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
 240     deleteWindows
 241     frame .f1 -container 1 -width 200 -height 50
 242     pack .f1
 243     toplevel .t1 -use [winfo id .f1] -width 150 -height 80
 244     update
 245     wm geometry .t1 70x300+10+20
 246     update
 247     wm geometry .t1
 248 } {70x300+0+0}
 249
 250
 251
 252 deleteWindows
 253
 254 # cleanup
 255 ::tcltest::cleanupTests
 256 return
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269