1# This file is a Tcl script to test out the "place" command. It is 2# organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1995 Sun Microsystems, Inc. 5# Copyright (c) 1998-1999 by Scriptics Corporation. 6# All rights reserved. 7 8package require tcltest 2.2 9namespace import ::tcltest::* 10eval tcltest::configure $argv 11tcltest::loadTestedCommands 12 13# Used for constraining memory leak tests 14testConstraint memory [llength [info commands memory]] 15 16testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] 17testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] 18 19# XXX - This test file is woefully incomplete. At present, only a 20# few of the features are tested. 21 22# Widgets used in tests 1.* - 8.* 23toplevel .t -width 300 -height 200 -bd 0 24wm geom .t +0+0 25frame .t.f -width 154 -height 84 -bd 2 -relief raised 26place .t.f -x 48 -y 38 27frame .t.f2 -width 30 -height 60 -bd 2 -relief raised 28update 29 30test place-1.1 {Tk_PlaceCmd procedure, "info" option} -setup { 31 place forget .t.f2 32} -body { 33 place .t.f2 -x 0 34 place info .t.f2 35} -result {-in .t -x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw -bordermode inside} 36test place-1.2 {Tk_PlaceCmd procedure, "info" option} -setup { 37 place forget .t.f2 38} -body { 39 place .t.f2 -x 1 -y 2 -width 3 -height 4 -relx 0.1 -rely 0.2 \ 40 -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f \ 41 -bordermode outside 42 place info .t.f2 43} -result {-in .t.f -x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside} 44test place-1.3 {Tk_PlaceCmd procedure, "info" option} -setup { 45 place forget .t.f2 46 destroy .t.a.b 47} -body { 48 # Make sure the result is built as a proper list by using a space in parent 49 frame ".t.a b" 50 place .t.f2 -x 1 -y 2 -width {} -height 4 -relx 0.2 -rely 0.2 \ 51 -relwidth 0.3 -relheight {} -anchor w -in ".t.a b" \ 52 -bordermode ignore 53 place info .t.f2 54} -cleanup { 55 destroy ".t.a.b" 56} -result {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore} 57 58 59test place-2.1 {ConfigureContent procedure, -height option} -body { 60 place .t.f2 -height abcd 61} -returnCodes error -result {bad screen distance "abcd"} 62test place-2.2 {ConfigureContent procedure, -height option} -setup { 63 place forget .t.f2 64} -body { 65 place .t.f2 -in .t.f -height 40 66 update 67 winfo height .t.f2 68} -result {40} 69test place-2.3 {ConfigureContent procedure, -height option} -setup { 70 place forget .t.f2 71} -body { 72 place .t.f2 -in .t.f -height 120 73 update 74 place .t.f2 -height {} 75 update 76 winfo height .t.f2 77} -result {60} 78 79 80test place-3.1 {ConfigureContent procedure, -relheight option} -body { 81 place .t.f2 -relheight abcd 82} -returnCodes error -result {expected floating-point number but got "abcd"} 83test place-3.2 {ConfigureContent procedure, -relheight option} -setup { 84 place forget .t.f2 85} -body { 86 place .t.f2 -in .t.f -relheight .5 87 update 88 winfo height .t.f2 89} -result {40} 90test place-3.3 {ConfigureContent procedure, -relheight option} -setup { 91 place forget .t.f2 92} -body { 93 place .t.f2 -in .t.f -relheight .8 94 update 95 place .t.f2 -relheight {} 96 update 97 winfo height .t.f2 98} -result {60} 99 100 101test place-4.1 {ConfigureContent procedure, bad -in options} -setup { 102 place forget .t.f2 103} -body { 104 place .t.f2 -in .t.f2 105} -returnCodes error -result {can't place .t.f2 relative to itself} 106test place-4.2 {ConfigureContent procedure, bad -in option} -setup { 107 place forget .t.f2 108} -body { 109 set result [list [winfo manager .t.f2]] 110 catch {place .t.f2 -in .t.f2} 111 lappend result [winfo manager .t.f2] 112} -result {{} {}} 113test place-4.3 {ConfigureContent procedure, bad -in option} -setup { 114 place forget .t.f2 115} -body { 116 winfo manager .t.f2 117 place .t.f2 -in .t.f2 118} -returnCodes error -result {can't place .t.f2 relative to itself} 119test place-4.4 {ConfigureContent procedure, bad -in option} -setup { 120 place forget .t.f2 121} -body { 122 place .t.f2 -in . 123} -returnCodes error -result {can't place .t.f2 relative to .} 124test place-4.5 {ConfigureContent procedure, bad -in option} -setup { 125} -body { 126 frame .t.f1 127 place .t.f1 -in .t.f1 128} -returnCodes error -result {can't place .t.f1 relative to itself} 129test place-4.6 {prevent management loops} -setup { 130 place forget .t.f1 131} -body { 132 place .t.f1 -in .t.f2 133 place .t.f2 -in .t.f1 134} -returnCodes error -result {can't put .t.f2 inside .t.f1, would cause management loop} 135test place-4.7 {prevent management loops} -setup { 136 place forget .t.f1 137 place forget .t.f2 138} -body { 139 frame .t.f3 140 place .t.f1 -in .t.f2 141 place .t.f2 -in .t.f3 142 place .t.f3 -in .t.f1 143} -returnCodes error -result {can't put .t.f3 inside .t.f1, would cause management loop} 144 145test place-5.1 {ConfigureContent procedure, -relwidth option} -body { 146 place .t.f2 -relwidth abcd 147} -returnCodes error -result {expected floating-point number but got "abcd"} 148test place-5.2 {ConfigureContent procedure, -relwidth option} -setup { 149 place forget .t.f2 150} -body { 151 place .t.f2 -in .t.f -relwidth .5 152 update 153 winfo width .t.f2 154} -result {75} 155test place-5.3 {ConfigureContent procedure, -relwidth option} -setup { 156 place forget .t.f2 157} -body { 158 place .t.f2 -in .t.f -relwidth .8 159 update 160 place .t.f2 -relwidth {} 161 update 162 winfo width .t.f2 163} -result {30} 164 165test place-6.1 {ConfigureContent procedure, -width option} -body { 166 place .t.f2 -width abcd 167} -returnCodes error -result {bad screen distance "abcd"} 168test place-6.2 {ConfigureContent procedure, -width option} -setup { 169 place forget .t.f2 170} -body { 171 place .t.f2 -in .t.f -width 100 172 update 173 winfo width .t.f2 174} -result {100} 175test place-6.3 {ConfigureContent procedure, -width option} -setup { 176 place forget .t.f2 177} -body { 178 place .t.f2 -in .t.f -width 120 179 update 180 place .t.f2 -width {} 181 update 182 winfo width .t.f2 183} -result {30} 184 185 186test place-7.1 {ReconfigurePlacement procedure, computing position} -setup { 187 place forget .t.f2 188} -body { 189 place .t.f2 -in .t.f -x -2 -relx .5 -y 3 -rely .4 190 update 191 winfo geometry .t.f2 192} -result {30x60+123+75} 193test place-7.2 {ReconfigurePlacement procedure, position rounding} -setup { 194 place forget .t.f2 195} -body { 196 place .t.f2 -in .t.f -x -1.4 -y -2.3 197 update 198 winfo geometry .t.f2 199} -result {30x60+49+38} 200test place-7.3 {ReconfigurePlacement procedure, position rounding} -setup { 201 place forget .t.f2 202} -body { 203 place .t.f2 -in .t.f -x 1.4 -y 2.3 204 update 205 winfo geometry .t.f2 206} -result {30x60+51+42} 207test place-7.4 {ReconfigurePlacement procedure, position rounding} -setup { 208 place forget .t.f2 209} -body { 210 place .t.f2 -in .t.f -x -1.6 -y -2.7 211 update 212 winfo geometry .t.f2 213} -result {30x60+48+37} 214test place-7.5 {ReconfigurePlacement procedure, position rounding} -setup { 215 place forget .t.f2 216} -body { 217 place .t.f2 -in .t.f -x 1.6 -y 2.7 218 update 219 winfo geometry .t.f2 220} -result {30x60+52+43} 221test place-7.6 {ReconfigurePlacement procedure, position rounding} -setup { 222 destroy .t.f3 223} -body { 224 frame .t.f3 -width 100 -height 100 -bg #f00000 -bd 0 225 place .t.f3 -x 0 -y 0 226 raise .t.f2 227 place forget .t.f2 228 place .t.f2 -in .t.f3 -relx .303 -rely .406 -relwidth .304 -relheight .206 229 update 230 winfo geometry .t.f2 231} -cleanup { 232 destroy .t.f3 233} -result {31x20+30+41} 234test place-7.7 {ReconfigurePlacement procedure, computing size} -setup { 235 place forget .t.f2 236} -body { 237 place .t.f2 -in .t.f -width 120 -height 89 238 update 239 list [winfo width .t.f2] [winfo height .t.f2] 240} -result {120 89} 241test place-7.8 {ReconfigurePlacement procedure, computing size} -setup { 242 place forget .t.f2 243} -body { 244 place .t.f2 -in .t.f -relwidth .4 -relheight .5 245 update 246 list [winfo width .t.f2] [winfo height .t.f2] 247} -result {60 40} 248test place-7.9 {ReconfigurePlacement procedure, computing size} -setup { 249 place forget .t.f2 250} -body { 251 place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5 252 update 253 list [winfo width .t.f2] [winfo height .t.f2] 254} -result {70 36} 255test place-7.10 {ReconfigurePlacement procedure, computing size} -setup { 256 place forget .t.f2 257} -body { 258 place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5 259 place .t.f2 -width {} -relwidth {} -height {} -relheight {} 260 update 261 list [winfo width .t.f2] [winfo height .t.f2] 262} -result {30 60} 263 264if {[tk windowingsystem] ne "aqua"} { 265 proc placeUpdate {} { 266 update 267 } 268} else { 269 proc placeUpdate {} { 270 } 271} 272 273test place-8.1 {PlaceStructureProc, mapping and unmapping content} -constraints {failsOnUbuntu failsOnXQuarz} -setup { 274 place forget .t.f2 275 place forget .t.f 276} -body { 277 place .t.f2 -relx 1.0 -rely 1.0 -anchor sw 278 update idletasks 279 set result [winfo ismapped .t.f2] 280 wm iconify .t 281 lappend result [winfo ismapped .t.f2] 282 place .t.f2 -x 40 -y 30 -relx 0 -rely 0 -anchor nw 283 update idletasks 284 lappend result [winfo x .t.f2] [winfo y .t.f2] [winfo ismapped .t.f2] 285 wm deiconify .t 286 placeUpdate 287 lappend result [winfo ismapped .t.f2] 288} -result {1 0 40 30 0 1} 289test place-8.2 {PlaceStructureProc, mapping and unmapping content} -constraints {failsOnUbuntu failsOnXQuarz} -setup { 290 place forget .t.f2 291 place forget .t.f 292 update idletasks 293} -body { 294 place .t.f -x 0 -y 0 -width 200 -height 100 295 place .t.f2 -in .t.f -relx 1.0 -rely 1.0 -anchor sw -width 50 -height 20 296 update idletasks 297 set result [winfo ismapped .t.f2] 298 wm iconify .t 299 lappend result [winfo ismapped .t.f2] 300 place .t.f2 -x 40 -y 30 -relx 0 -rely 0 -anchor nw 301 update idletasks 302 lappend result [winfo x .t.f2] [winfo y .t.f2] [winfo ismapped .t.f2] 303 wm deiconify .t 304 placeUpdate 305 lappend result [winfo ismapped .t.f2] 306} -result {1 0 42 32 0 1} 307destroy .t 308 309 310test place-9.1 {PlaceObjCmd} -body { 311 place 312} -returnCodes error -result {wrong # args: should be "place option|pathName args"} 313test place-9.2 {PlaceObjCmd} -body { 314 place foo 315} -returnCodes error -result {wrong # args: should be "place option|pathName args"} 316test place-9.3 {PlaceObjCmd} -setup { 317 destroy .foo 318} -body { 319 place .foo bar 320} -returnCodes error -result {bad window path name ".foo"} 321test place-9.4 {PlaceObjCmd} -setup { 322 destroy .foo 323} -body { 324 place bar .foo 325} -cleanup { 326 destroy .foo 327} -returnCodes error -result {bad window path name ".foo"} 328test place-9.5 {PlaceObjCmd} -setup { 329 destroy .foo 330} -body { 331 frame .foo 332 place badopt .foo 333} -cleanup { 334 destroy .foo 335} -returnCodes error -result {bad option "badopt": must be configure, content, forget, info, or slaves} 336test place-9.6 {PlaceObjCmd, configure errors} -setup { 337 destroy .foo 338} -body { 339 frame .foo 340 place configure .foo 341} -cleanup { 342 destroy .foo 343} -returnCodes ok -result {} 344test place-9.7 {PlaceObjCmd, configure errors} -setup { 345 destroy .foo 346} -body { 347 frame .foo 348 place configure .foo bar 349} -cleanup { 350 destroy .foo 351} -returnCodes ok -result {} 352test place-9.8 {PlaceObjCmd, configure} -setup { 353 destroy .foo 354} -body { 355 frame .foo 356 place .foo -x 0 -y 0 357 place configure .foo 358} -cleanup { 359 destroy .foo 360} -result [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}] 361test place-9.9 {PlaceObjCmd, configure} -setup { 362 destroy .foo 363} -body { 364 frame .foo 365 place .foo -x 0 -y 0 366 place configure .foo -x 367} -cleanup { 368 destroy .foo 369} -result {-x {} {} 0 0} 370test place-9.10 {PlaceObjCmd, forget errors} -setup { 371 destroy .foo 372} -body { 373 frame .foo 374 place forget .foo bar 375} -cleanup { 376 destroy .foo 377} -returnCodes error -result {wrong # args: should be "place forget pathName"} 378test place-9.11 {PlaceObjCmd, info errors} -setup { 379 destroy .foo 380} -body { 381 frame .foo 382 place info .foo bar 383} -cleanup { 384 destroy .foo 385} -returnCodes error -result {wrong # args: should be "place info pathName"} 386test place-9.12 {PlaceObjCmd, content errors} -setup { 387 destroy .foo 388} -body { 389 frame .foo 390 place content .foo bar 391} -cleanup { 392 destroy .foo 393} -returnCodes error -result {wrong # args: should be "place content pathName"} 394 395 396test place-10.1 {ConfigureContent} -setup { 397 destroy .foo 398} -body { 399 frame .foo 400 place .foo -badopt 401} -cleanup { 402 destroy .foo 403} -returnCodes error -result {unknown option "-badopt"} 404test place-10.2 {ConfigureContent} -setup { 405 destroy .foo 406} -body { 407 frame .foo 408 place .foo -anchor 409} -cleanup { 410 destroy .foo 411} -returnCodes error -result {value for "-anchor" missing} 412test place-10.3 {ConfigureContent} -setup { 413 destroy .foo 414} -body { 415 frame .foo 416 place .foo -bordermode j 417} -cleanup { 418 destroy .foo 419} -returnCodes error -result {bad bordermode "j": must be inside, outside, or ignore} 420test place-10.4 {ConfigureContent} -setup { 421 destroy .foo 422} -body { 423 frame .foo 424 place configure .foo -x 0 -y 425} -cleanup { 426 destroy .foo 427} -returnCodes error -result {value for "-y" missing} 428 429 430test place-11.1 {PlaceObjCmd, content command} -setup { 431 destroy .foo 432} -body { 433 frame .foo 434 place content .foo 435} -cleanup { 436 destroy .foo 437} -result {} 438test place-11.2 {PlaceObjCmd, content command} -setup { 439 destroy .foo .bar 440} -body { 441 frame .foo 442 frame .bar 443 place .bar -in .foo 444 place content .foo 445} -cleanup { 446 destroy .foo .bar 447} -result [list .bar] 448 449 450test place-12.1 {PlaceObjCmd, forget command} -setup { 451 destroy .foo 452} -body { 453 frame .foo 454 place .foo -width 50 -height 50 455 update 456 set res [winfo ismapped .foo] 457 place forget .foo 458 update 459 lappend res [winfo ismapped .foo] 460} -cleanup { 461 destroy .foo 462} -result {1 0} 463 464 465test place-13.1 {test respect for internalborder} -setup { 466 destroy .pack 467} -body { 468 toplevel .pack 469 wm geometry .pack 200x200 470 frame .pack.l -width 15 -height 10 471 labelframe .pack.lf -labelwidget .pack.l 472 pack .pack.lf -fill both -expand 1 473 frame .pack.lf.f 474 place .pack.lf.f -x 0 -y 0 -relwidth 1.0 -relheight 1.0 475 update 476 set res [list [winfo geometry .pack.lf.f]] 477 .pack.lf configure -labelanchor e -padx 3 -pady 5 478 update 479 lappend res [winfo geometry .pack.lf.f] 480} -cleanup { 481 destroy .pack 482} -result {196x188+2+10 177x186+5+7} 483 484 485test place-14.1 {memory leak testing} -constraints memory -setup { 486 destroy .f 487 proc getbytes {} { 488 set lines [split [memory info] "\n"] 489 lindex [lindex $lines 3] 3 490 } 491 # Repeat each body checking that memory does not increase 492 proc stress {args} { 493 set res {} 494 foreach body $args { 495 set end 0 496 for {set i 0} {$i < 5} {incr i} { 497 uplevel 1 $body 498 set tmp $end 499 set end [getbytes] 500 } 501 lappend res [expr {$end - $tmp}] 502 } 503 return $res 504 } 505} -body { 506 # Test all manners of forgetting content 507 frame .f 508 frame .f.f 509 stress { 510 place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] 511 place forget .f.f 512 } { 513 place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] 514 pack .f.f 515 } { 516 place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] 517 destroy .f 518 frame .f 519 frame .f.f 520 } 521} -cleanup { 522 destroy .f 523 rename getbytes {} 524 rename stress {} 525} -result {0 0 0} 526 527 528# cleanup 529cleanupTests 530return 531 532 533 534