util/src/TclTk/tk8.6.12/tests/frame.test

   1 # This file is a Tcl script to test out the "frame" and "toplevel"
   2 # commands of Tk.  It is organized in the standard fashion for Tcl
   3 # tests.
   4 #
   5 # Copyright (c) 1994 The Regents of the University of California.
   6 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
   7 # Copyright (c) 1998-1999 by Scriptics Corporation.
   8 # All rights reserved.
   9
  10 package require tcltest 2.2
  11 namespace import ::tcltest::*
  12 eval tcltest::configure $argv
  13 tcltest::loadTestedCommands
  14
  15 # eatColors --
  16 # Creates a toplevel window and allocates enough colors in it to
  17 # use up all the slots in the colormap.
  18 #
  19 # Arguments:
  20 # w -           Name of toplevel window to create.
  21
  22 proc eatColors {w} {
  23     catch {destroy $w}
  24     toplevel $w
  25     wm geom $w +0+0
  26     canvas $w.c -width 400 -height 200 -bd 0
  27     pack $w.c
  28     for {set y 0} {$y < 8} {incr y} {
  29         for {set x 0} {$x < 40} {incr x} {
  30             set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  31             $w.c create rectangle [expr 10*$x] [expr 20*$y] \
  32                     [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
  33                     -fill $color
  34         }
  35     }
  36     update
  37 }
  38
  39 # colorsFree --
  40 #
  41 # Returns 1 if there appear to be free colormap entries in a window,
  42 # 0 otherwise.
  43 #
  44 # Arguments:
  45 # w -                   Name of window in which to check.
  46 # red, green, blue -    Intensities to use in a trial color allocation
  47 #                       to see if there are colormap entries free.
  48
  49 proc colorsFree {w {red 31} {green 245} {blue 192}} {
  50     set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
  51     expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
  52             && ([lindex $vals 2]/256 == $blue)
  53 }
  54
  55
  56 test frame-1.1 {frame configuration options} -setup {
  57         deleteWindows
  58 } -body {
  59     frame .f -class NewFrame
  60     .f configure -class
  61 } -cleanup {
  62     deleteWindows
  63 } -result {-class class Class Frame NewFrame}
  64 test frame-1.2 {frame configuration options} -setup {
  65     deleteWindows
  66 } -body {
  67     frame .f -class NewFrame
  68     .f configure -class Different
  69 } -cleanup {
  70     deleteWindows
  71 } -returnCodes error -result {can't modify -class option after widget is created}
  72
  73 test frame-1.3 {frame configuration options} -setup {
  74         deleteWindows
  75 } -body {
  76     frame .f -colormap new
  77     .f configure -colormap
  78 } -cleanup {
  79     deleteWindows
  80 } -result {-colormap colormap Colormap {} new}
  81 test frame-1.4 {frame configuration options} -setup {
  82     deleteWindows
  83 } -body {
  84     frame .f -colormap new
  85     .f configure -colormap .
  86 } -cleanup {
  87     deleteWindows
  88 } -returnCodes error -result {can't modify -colormap option after widget is created}
  89
  90 test frame-1.5 {frame configuration options} -setup {
  91         deleteWindows
  92 } -body {
  93     frame .f -visual default
  94     .f configure -visual
  95 } -cleanup {
  96     deleteWindows
  97 } -result {-visual visual Visual {} default}
  98 test frame-1.6 {frame configuration options} -setup {
  99     deleteWindows
 100 } -body {
 101     frame .f -visual default
 102     .f configure -visual best
 103 } -cleanup {
 104     deleteWindows
 105 } -returnCodes error -result {can't modify -visual option after widget is created}
 106
 107 test frame-1.7 {frame configuration options} -setup {
 108         deleteWindows
 109 } -body {
 110     frame .f -screen bogus
 111 } -cleanup {
 112     deleteWindows
 113 } -returnCodes error -result {unknown option "-screen"}
 114 test frame-1.8 {frame configuration options} -setup {
 115         deleteWindows
 116 } -body {
 117     frame .f -container true
 118 } -cleanup {
 119     deleteWindows
 120 } -result {.f}
 121 test frame-1.9 {frame configuration options} -setup {
 122     deleteWindows
 123 } -body {
 124     frame .f -container true
 125     .f configure -container
 126 } -cleanup {
 127     deleteWindows
 128 } -result {-container container Container 0 1}
 129 test frame-1.10 {frame configuration options} -setup {
 130         deleteWindows
 131 } -body {
 132     frame .f -container bogus
 133 } -cleanup {
 134     deleteWindows
 135 } -returnCodes error -result {expected boolean value but got "bogus"}
 136 test frame-1.11 {frame configuration options} -setup {
 137         deleteWindows
 138 } -body {
 139     frame .f
 140     .f configure -container 1
 141 } -cleanup {
 142     deleteWindows
 143 } -returnCodes error -result {can't modify -container option after widget is created}
 144 test frame-1.12 {frame configuration options} -setup {
 145         deleteWindows
 146 } -body {
 147     # Make sure all options can be set to the default value
 148     frame .f
 149     set opts {}
 150     foreach opt [.f configure] {
 151         if {[llength $opt] == 5} {
 152             lappend opts [lindex $opt 0] [lindex $opt 4]
 153         }
 154     }
 155     eval frame .g $opts
 156     destroy .f .g
 157 } -cleanup {
 158     deleteWindows
 159 } -result {}
 160
 161 destroy .f
 162 frame .f
 163 test frame-1.13 {frame configuration options} -body {
 164     .f configure -background #ff0000
 165     lindex [.f configure -background] 4
 166 } -cleanup {
 167     .f configure -background [lindex [.f configure -background] 3]
 168 } -result {#ff0000}
 169 test frame-1.14 {frame configuration options} -body {
 170     .f configure -background non-existent
 171 } -returnCodes error -result {unknown color name "non-existent"}
 172 test frame-1.15 {frame configuration options} -body {
 173     .f configure -bd 4
 174     lindex [.f configure -bd] 4
 175 } -cleanup {
 176     .f configure -bd [lindex [.f configure -bd] 3]
 177 } -result {4}
 178 test frame-1.16 {frame configuration options} -body {
 179     .f configure -bd badValue
 180 } -returnCodes error -result {bad screen distance "badValue"}
 181 test frame-1.17 {frame configuration options} -body {
 182     .f configure -bg #00ff00
 183     lindex [.f configure -bg] 4
 184 } -cleanup {
 185     .f configure -bg [lindex [.f configure -bg] 3]
 186 } -result {#00ff00}
 187 test frame-1.18 {frame configuration options} -body {
 188     .f configure -bg non-existent
 189 } -returnCodes error -result {unknown color name "non-existent"}
 190 test frame-1.19 {frame configuration options} -body {
 191     .f configure -borderwidth 1.3
 192     lindex [.f configure -borderwidth] 4
 193 } -cleanup {
 194     .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
 195 } -result {1}
 196 test frame-1.20 {frame configuration options} -body {
 197     .f configure -borderwidth badValue
 198 } -returnCodes error -result {bad screen distance "badValue"}
 199 test frame-1.21 {frame configuration options} -body {
 200     .f configure -cursor arrow
 201     lindex [.f configure -cursor] 4
 202 } -cleanup {
 203     .f configure -cursor [lindex [.f configure -cursor] 3]
 204 } -result {arrow}
 205 test frame-1.22 {frame configuration options} -body {
 206     .f configure -cursor badValue
 207 } -returnCodes error -result {bad cursor spec "badValue"}
 208 test frame-1.23 {frame configuration options} -body {
 209     .f configure -height 100
 210     lindex [.f configure -height] 4
 211 } -cleanup {
 212     .f configure -height [lindex [.f configure -height] 3]
 213 } -result {100}
 214 test frame-1.24 {frame configuration options} -body {
 215     .f configure -height not_a_number
 216 } -returnCodes error -result {bad screen distance "not_a_number"}
 217 test frame-1.25 {frame configuration options} -body {
 218     .f configure -highlightbackground #112233
 219     lindex [.f configure -highlightbackground] 4
 220 } -cleanup {
 221     .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
 222 } -result {#112233}
 223 test frame-1.26 {frame configuration options} -body {
 224     .f configure -highlightbackground ugly
 225 } -returnCodes error -result {unknown color name "ugly"}
 226 test frame-1.27 {frame configuration options} -body {
 227     .f configure -highlightcolor #123456
 228     lindex [.f configure -highlightcolor] 4
 229 } -cleanup {
 230     .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
 231 } -result {#123456}
 232 test frame-1.28 {frame configuration options} -body {
 233     .f configure -highlightcolor non-existent
 234 } -returnCodes error -result {unknown color name "non-existent"}
 235 test frame-1.29 {frame configuration options} -body {
 236     .f configure -highlightthickness 6
 237     lindex [.f configure -highlightthickness] 4
 238 } -cleanup {
 239     .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
 240 } -result {6}
 241 test frame-1.30 {frame configuration options} -body {
 242     .f configure -highlightthickness badValue
 243 } -returnCodes error -result {bad screen distance "badValue"}
 244 test frame-1.31 {frame configuration options} -body {
 245     .f configure -padx 3
 246     lindex [.f configure -padx] 4
 247 } -cleanup {
 248     .f configure -padx [lindex [.f configure -padx] 3]
 249 } -result {3}
 250 test frame-1.32 {frame configuration options} -body {
 251     .f configure -padx badValue
 252 } -returnCodes error -result {bad screen distance "badValue"}
 253 test frame-1.33 {frame configuration options} -body {
 254     .f configure -pady 4
 255     lindex [.f configure -pady] 4
 256 } -cleanup {
 257     .f configure -pady [lindex [.f configure -pady] 3]
 258 } -result {4}
 259 test frame-1.34 {frame configuration options} -body {
 260     .f configure -pady badValue
 261 } -returnCodes error -result {bad screen distance "badValue"}
 262 test frame-1.35 {frame configuration options} -body {
 263     .f configure -relief ridge
 264     lindex [.f configure -relief] 4
 265 } -cleanup {
 266     .f configure -relief [lindex [.f configure -relief] 3]
 267 } -result {ridge}
 268 test frame-1.36 {frame configuration options} -body {
 269     .f configure -relief badValue
 270 } -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
 271 test frame-1.37 {frame configuration options} -body {
 272     .f configure -takefocus {any string}
 273     lindex [.f configure -takefocus] 4
 274 } -cleanup {
 275     .f configure -takefocus [lindex [.f configure -takefocus] 3]
 276 } -result {any string}
 277 test frame-1.38 {frame configuration options} -body {
 278     .f configure -width 32
 279     lindex [.f configure -width] 4
 280 } -cleanup {
 281     .f configure -width [lindex [.f configure -width] 3]
 282 } -result {32}
 283 test frame-1.39 {frame configuration options} -body {
 284     .f configure -width badValue
 285 } -returnCodes error -result {bad screen distance "badValue"}
 286 destroy .f
 287
 288
 289 test frame-2.1 {toplevel configuration options} -setup {
 290         deleteWindows
 291 } -body {
 292     toplevel .t -width 200 -height 100 -class NewClass
 293     wm geometry .t +0+0
 294     .t configure -class
 295 } -cleanup {
 296     deleteWindows
 297 } -result {-class class Class Toplevel NewClass}
 298 test frame-2.2 {toplevel configuration options} -setup {
 299     deleteWindows
 300 } -body {
 301     toplevel .t -width 200 -height 100 -class NewClass
 302     wm geometry .t +0+0
 303     .t configure -class Another
 304 } -cleanup {
 305     deleteWindows
 306 } -returnCodes error -result {can't modify -class option after widget is created}
 307
 308 test frame-2.3 {toplevel configuration options} -setup {
 309         deleteWindows
 310 } -body {
 311     toplevel .t -width 200 -height 100 -colormap new
 312     wm geometry .t +0+0
 313     .t configure -colormap
 314 } -cleanup {
 315     deleteWindows
 316 } -result {-colormap colormap Colormap {} new}
 317 test frame-2.4 {toplevel configuration options} -setup {
 318     deleteWindows
 319 } -body {
 320     toplevel .t -width 200 -height 100 -colormap new
 321     wm geometry .t +0+0
 322     .t configure -colormap .
 323 } -cleanup {
 324     deleteWindows
 325 } -returnCodes error -result {can't modify -colormap option after widget is created}
 326
 327 test frame-2.5 {toplevel configuration options} -setup {
 328         deleteWindows
 329 } -body {
 330     toplevel .t -width 200 -height 100
 331     wm geometry .t +0+0
 332     .t configure -container 1
 333 } -cleanup {
 334     deleteWindows
 335 } -returnCodes error -result {can't modify -container option after widget is created}
 336 test frame-2.6 {toplevel configuration options} -setup {
 337     deleteWindows
 338 } -body {
 339     catch {destroy .t}
 340     toplevel .t -width 200 -height 100
 341     wm geometry .t +0+0
 342     catch {.t configure -container 1}
 343     .t configure -container
 344 } -cleanup {
 345     deleteWindows
 346 } -result {-container container Container 0 0}
 347
 348 test frame-2.7 {toplevel configuration options} -setup {
 349         deleteWindows
 350 } -body {
 351     toplevel .t -width 200 -height 100 -colormap bogus
 352 } -cleanup {
 353     deleteWindows
 354 } -returnCodes error -result {bad window path name "bogus"}
 355
 356
 357 test frame-2.8 {toplevel configuration options} -constraints {
 358     win
 359 } -setup {
 360         deleteWindows
 361 } -body {
 362     catch {destroy .t}
 363     toplevel .t -width 200 -height 100
 364     wm geometry .t +0+0
 365     .t configure -use 0x44022
 366 } -cleanup {
 367     deleteWindows
 368 } -returnCodes error -result {window "0x44022" doesn't exist}
 369 test frame-2.9 {toplevel configuration options} -constraints {
 370     win
 371 } -setup {
 372     deleteWindows
 373 } -body {
 374     catch {destroy .t}
 375     toplevel .t -width 200 -height 100
 376     wm geometry .t +0+0
 377     catch {.t configure -use 0x44022}
 378     .t configure -use
 379 } -cleanup {
 380     deleteWindows
 381 } -result {-use use Use {} {}}
 382
 383 test frame-2.10 {toplevel configuration options} -constraints {
 384     nonwin
 385 } -setup {
 386     deleteWindows
 387 } -body {
 388     catch {destroy .t}
 389     toplevel .t -width 200 -height 100
 390     wm geometry .t +0+0
 391     .t configure -use 0x44022
 392 } -cleanup {
 393     deleteWindows
 394 } -returnCodes error -result {can't modify -use option after widget is created}
 395 test frame-2.11 {toplevel configuration options} -constraints {
 396     nonwin
 397 } -setup {
 398         deleteWindows
 399 } -body {
 400     catch {destroy .t}
 401     toplevel .t -width 200 -height 100
 402     wm geometry .t +0+0
 403     catch {.t configure -use 0x44022}
 404     .t configure -use
 405 } -cleanup {
 406     deleteWindows
 407 } -result {-use use Use {} {}}
 408
 409 test frame-2.12 {toplevel configuration options} -setup {
 410         deleteWindows
 411 } -body {
 412     catch {destroy .t}
 413     toplevel .t -width 200 -height 100 -visual default
 414     wm geometry .t +0+0
 415     .t configure -visual
 416 } -cleanup {
 417     deleteWindows
 418 } -result {-visual visual Visual {} default}
 419 test frame-2.13 {toplevel configuration options} -setup {
 420     deleteWindows
 421 } -body {
 422     catch {destroy .t}
 423     toplevel .t -width 200 -height 100 -visual default
 424     wm geometry .t +0+0
 425     .t configure -visual best
 426 } -cleanup {
 427     deleteWindows
 428 } -returnCodes error -result {can't modify -visual option after widget is created}
 429
 430 test frame-2.14 {toplevel configuration options} -setup {
 431         deleteWindows
 432 } -body {
 433     toplevel .t -width 200 -height 100 -visual who_knows?
 434 } -cleanup {
 435     deleteWindows
 436 } -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
 437 test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {
 438         deleteWindows
 439 } -body {
 440     toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
 441     wm geometry .t +0+0
 442     string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)"
 443 } -cleanup {
 444     deleteWindows
 445 } -result {0}
 446 test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {
 447     deleteWindows
 448 } -body {
 449     toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
 450     wm geometry .t +0+0
 451     .t configure -screen another
 452 } -cleanup {
 453     deleteWindows
 454 } -returnCodes error -result {can't modify -screen option after widget is created}
 455
 456 test frame-2.17 {toplevel configuration options} -setup {
 457         deleteWindows
 458 } -body {
 459     toplevel .t -width 200 -height 100 -screen bogus
 460 } -cleanup {
 461     deleteWindows
 462 } -returnCodes error -result {couldn't connect to display "bogus"}
 463 test frame-2.18 {toplevel configuration options} -setup {
 464         deleteWindows
 465 } -body {
 466     toplevel .t -container 1 -width 300 -height 120
 467     wm geometry .t +0+0
 468     toplevel .x -container 1 -use [winfo id .t]
 469 } -cleanup {
 470     deleteWindows
 471 } -returnCodes error -result {windows cannot have both the -use and the -container option set}
 472 test frame-2.19 {toplevel configuration options} -setup {
 473         deleteWindows
 474     set opts {}
 475 } -body {
 476     # Make sure all options can be set to the default value
 477     toplevel .f
 478     foreach opt [.f configure] {
 479         if {[llength $opt] == 5} {
 480             lappend opts [lindex $opt 0] [lindex $opt 4]
 481         }
 482     }
 483     eval toplevel .g $opts
 484     destroy .f .g
 485 } -cleanup {
 486     deleteWindows
 487 } -result {}
 488
 489
 490 destroy .t
 491 toplevel .t -width 300 -height 150
 492 wm geometry .t +0+0
 493 update
 494 test frame-2.20 {toplevel configuration options} -body {
 495     .t configure -background #ff0000
 496     lindex [.t configure -background] 4
 497 } -result {#ff0000}
 498 test frame-2.21 {toplevel configuration options} -body {
 499     .t configure -background non-existent
 500 } -returnCodes error -result {unknown color name "non-existent"}
 501 test frame-2.22 {toplevel configuration options} -body {
 502     .t configure -bd 4
 503     lindex [.t configure -bd] 4
 504 } -result {4}
 505 test frame-2.23 {toplevel configuration options} -body {
 506     .t configure -bd badValue
 507 } -returnCodes error -result {bad screen distance "badValue"}
 508 test frame-2.24 {toplevel configuration options} -body {
 509     .t configure -bg #00ff00
 510     lindex [.t configure -bg] 4
 511 } -result {#00ff00}
 512 test frame-2.25 {toplevel configuration options} -body {
 513     .t configure -bg non-existent
 514 } -returnCodes error -result {unknown color name "non-existent"}
 515 test frame-2.26 {toplevel configuration options} -body {
 516     .t configure -borderwidth 1.3
 517     lindex [.t configure -borderwidth] 4
 518 } -result {1}
 519 test frame-2.27 {toplevel configuration options} -body {
 520     .t configure -borderwidth badValue
 521 } -returnCodes error -result {bad screen distance "badValue"}
 522 test frame-2.28 {toplevel configuration options} -body {
 523     .t configure -cursor arrow
 524     lindex [.t configure -cursor] 4
 525 } -result {arrow}
 526 test frame-2.29 {toplevel configuration options} -body {
 527     .t configure -cursor badValue
 528 } -returnCodes error -result {bad cursor spec "badValue"}
 529 test frame-2.30 {toplevel configuration options} -body {
 530     .t configure -height 100
 531     lindex [.t configure -height] 4
 532 } -result {100}
 533 test frame-2.31 {toplevel configuration options} -body {
 534     .t configure -height not_a_number
 535 } -returnCodes error -result {bad screen distance "not_a_number"}
 536 test frame-2.32 {toplevel configuration options} -body {
 537     .t configure -highlightcolor #123456
 538     lindex [.t configure -highlightcolor] 4
 539 } -result {#123456}
 540 test frame-2.33 {toplevel configuration options} -body {
 541     .t configure -highlightcolor non-existent
 542 } -returnCodes error -result {unknown color name "non-existent"}
 543 test frame-2.34 {toplevel configuration options} -body {
 544     .t configure -highlightthickness 3
 545     lindex [.t configure -highlightthickness] 4
 546 } -result {3}
 547 test frame-2.35 {toplevel configuration options} -body {
 548     .t configure -highlightthickness badValue
 549 } -returnCodes error -result {bad screen distance "badValue"}
 550 test frame-2.36 {toplevel configuration options} -body {
 551     .t configure -padx 3
 552     lindex [.t configure -padx] 4
 553 } -result {3}
 554 test frame-2.37 {toplevel configuration options} -body {
 555     .t configure -padx badValue
 556 } -returnCodes error -result {bad screen distance "badValue"}
 557 test frame-2.38 {toplevel configuration options} -body {
 558     .t configure -pady 4
 559     lindex [.t configure -pady] 4
 560 } -result {4}
 561 test frame-2.39 {toplevel configuration options} -body {
 562     .t configure -pady badValue
 563 } -returnCodes error -result {bad screen distance "badValue"}
 564 test frame-2.40 {toplevel configuration options} -body {
 565     .t configure -relief ridge
 566     lindex [.t configure -relief] 4
 567 } -result {ridge}
 568 test frame-2.41 {toplevel configuration options} -body {
 569     .t configure -relief badValue
 570 } -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
 571 test frame-2.42 {toplevel configuration options} -body {
 572     .t configure -width 32
 573     lindex [.t configure -width] 4
 574 } -result {32}
 575 test frame-2.43 {toplevel configuration options} -body {
 576     .t configure -width badValue
 577 } -returnCodes error -result {bad screen distance "badValue"}
 578 destroy .t
 579
 580
 581 test frame-3.1 {TkCreateFrame procedure} -body {
 582     frame
 583 } -returnCodes error -result {wrong # args: should be "frame pathName ?-option value ...?"}
 584 test frame-3.2 {TkCreateFrame procedure} -setup {
 585         deleteWindows
 586     frame .f
 587 } -body {
 588     .f configure -class
 589 } -cleanup {
 590     deleteWindows
 591 } -result {-class class Class Frame Frame}
 592 test frame-3.3 {TkCreateFrame procedure} -setup {
 593         deleteWindows
 594     toplevel .t
 595     wm geometry .t +0+0
 596 } -body {
 597     .t configure -class
 598 } -cleanup {
 599     deleteWindows
 600 } -result {-class class Class Toplevel Toplevel}
 601 test frame-3.4 {TkCreateFrame procedure} -setup {
 602         deleteWindows
 603 } -body {
 604     toplevel .t -width 350 -class NewClass -bg black -visual default -height 90
 605     wm geometry .t +0+0
 606     update
 607     list [lindex [.t configure -width] 4] \
 608             [lindex [.t configure -background] 4] \
 609             [lindex [.t configure -height] 4]
 610 } -cleanup {
 611     deleteWindows
 612 } -result {350 black 90}
 613
 614 # Be sure that the -class, -colormap, and -visual options are processed
 615 # before configuring the widget.
 616 test frame-3.5 {TkCreateFrame procedure} -setup {
 617         deleteWindows
 618 } -body {
 619     option add *NewFrame.background #123456
 620     frame .f -class NewFrame
 621     lindex [.f configure -background] 4
 622 } -cleanup {
 623     deleteWindows
 624     option clear
 625 } -result {#123456}
 626 test frame-3.7 {TkCreateFrame procedure} -setup {
 627         deleteWindows
 628 } -body {
 629     option add *NewFrame.background #332211
 630     option add *f.class NewFrame
 631     frame .f
 632     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
 633 } -cleanup {
 634     deleteWindows
 635     option clear
 636 } -result {NewFrame #332211}
 637 test frame-3.8 {TkCreateFrame procedure} -setup {
 638         deleteWindows
 639 } -body {
 640     option add *Silly.background #122334
 641     option add *f.Class Silly
 642     frame .f
 643     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
 644 } -cleanup {
 645     deleteWindows
 646     option clear
 647 } -result {Silly #122334}
 648 test frame-3.9 {TkCreateFrame procedure, -use option} -constraints {
 649     unix
 650 } -setup {
 651         deleteWindows
 652 } -body {
 653     toplevel .t -container 1 -width 300 -height 120
 654     wm geometry .t +0+0
 655     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
 656     tkwait visibility .x
 657     list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
 658             [expr {[winfo rooty .x] - [winfo rooty .t]}] \
 659             [winfo width .t] [winfo height .t]
 660 } -cleanup {
 661 # This call to update idletasks was added to prevent a crash that was
 662 # observed on OSX 10.12 (Sierra) only.  Any change, such as using the
 663 # Development version to make debugging symbols available, adding a print
 664 # statement, or calling update idletasks here, would make the test pass
 665 # with no segfault.
 666     update idletasks
 667     deleteWindows
 668 } -result {0 0 140 300}
 669 test frame-3.10 {TkCreateFrame procedure, -use option} -constraints {
 670     unix
 671 } -setup {
 672     deleteWindows
 673 } -body {
 674     toplevel .t -container 1 -width 300 -height 120
 675     wm geometry .t +0+0
 676     if {[tk windowingsystem] eq "aqua"} {
 677         update idletasks
 678     } else {
 679         update
 680     }
 681     option add *x.use [winfo id .t]
 682     toplevel .x -width 140 -height 300 -bg green
 683     if {[tk windowingsystem] eq "aqua"} {
 684         update idletasks
 685     } else {
 686         tkwait visibility .x
 687         update
 688     }
 689     list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
 690             [expr {[winfo rooty .x] - [winfo rooty .t]}] \
 691             [winfo width .t] [winfo height .t]
 692 } -cleanup {
 693     destroy .t
 694     option clear
 695 } -result {0 0 140 300}
 696
 697 # The tests below require specific display characteristics (i.e. that
 698 # they are run on a pseudocolor display of depth 8).  Even so, they
 699 # are non-portable: some machines don't seem to ever run out of
 700 # colors.
 701 if {[testConstraint defaultPseudocolor8]} {
 702     eatColors .t1
 703 }
 704 test frame-3.11 {TkCreateFrame procedure} -constraints {
 705         defaultPseudocolor8 nonPortable
 706 } -setup {
 707         deleteWindows
 708 } -body {
 709     toplevel .t -width 300 -height 200 -bg #475601
 710     wm geometry .t +0+0
 711     update
 712     colorsFree .t
 713 } -cleanup {
 714     deleteWindows
 715 } -result {0}
 716 test frame-3.12 {TkCreateFrame procedure} -constraints {
 717         defaultPseudocolor8 nonPortable
 718 } -setup {
 719         deleteWindows
 720 } -body {
 721     toplevel .t -width 300 -height 200 -bg #475601 -colormap new
 722     wm geometry .t +0+0
 723     update
 724     colorsFree .t
 725 } -cleanup {
 726     deleteWindows
 727 } -result {1}
 728 test frame-3.13 {TkCreateFrame procedure} -constraints {
 729         defaultPseudocolor8 nonPortable
 730 } -setup {
 731         deleteWindows
 732 } -body {
 733     option add *t.class Toplevel2
 734     option add *Toplevel2.colormap new
 735     toplevel .t -width 300 -height 200 -bg #475601
 736     wm geometry .t +0+0
 737     update
 738     option clear
 739     colorsFree .t
 740 } -cleanup {
 741     deleteWindows
 742 } -result {1}
 743 test frame-3.14 {TkCreateFrame procedure} -constraints {
 744         defaultPseudocolor8 nonPortable
 745 } -setup {
 746         deleteWindows
 747 } -body {
 748     option add *t.class Toplevel3
 749     option add *Toplevel3.Colormap new
 750     toplevel .t -width 300 -height 200 -bg #475601 -colormap new
 751     wm geometry .t +0+0
 752     update
 753     option clear
 754     colorsFree .t
 755 } -cleanup {
 756     deleteWindows
 757 } -result {1}
 758 test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {
 759     defaultPseudocolor8 unix nonPortable
 760 } -setup {
 761     deleteWindows
 762 } -body {
 763     toplevel .t -container 1 -width 300 -height 120
 764     wm geometry .t +0+0
 765     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
 766     tkwait visibility .x
 767     list [colorsFree .t] [colorsFree .x]
 768 } -cleanup {
 769     destroy .t
 770 } -result {0 1}
 771 test frame-3.16 {TkCreateFrame procedure} -constraints {
 772         defaultPseudocolor8 nonPortable
 773 } -setup {
 774         deleteWindows
 775 } -body {
 776     toplevel .t -width 300 -height 200 -bg #475601 -visual default
 777     wm geometry .t +0+0
 778     update
 779     colorsFree .t
 780 } -cleanup {
 781     deleteWindows
 782 } -result {0}
 783 test frame-3.17 {TkCreateFrame procedure} -constraints {
 784         defaultPseudocolor8 nonPortable
 785 } -setup {
 786         deleteWindows
 787 } -body {
 788     toplevel .t -width 300 -height 200 -bg #475601 -visual default \
 789             -colormap new
 790     wm geometry .t +0+0
 791     update
 792     colorsFree .t
 793 } -cleanup {
 794     deleteWindows
 795 } -result {1}
 796 test frame-3.18 {TkCreateFrame procedure} -constraints {
 797         defaultPseudocolor8 haveGrayscale8 nonPortable
 798 } -setup {
 799         deleteWindows
 800 } -body {
 801     toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
 802     wm geometry .t +0+0
 803     update
 804     colorsFree .t 131 131 131
 805 } -cleanup {
 806     deleteWindows
 807 } -result {1}
 808 test frame-3.19 {TkCreateFrame procedure} -constraints {
 809         defaultPseudocolor8 haveGrayscale8 nonPortable
 810 } -setup {
 811         deleteWindows
 812 } -body {
 813     option add *t.class T4
 814     option add *T4.visual {grayscale 8}
 815     toplevel .t -width 300 -height 200 -bg #434343
 816     wm geometry .t +0+0
 817     update
 818     option clear
 819     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
 820 } -cleanup {
 821     deleteWindows
 822 } -result {1 {grayscale 8}}
 823 test frame-3.20 {TkCreateFrame procedure} -constraints {
 824         defaultPseudocolor8 haveGrayscale8 nonPortable
 825 } -setup {
 826         deleteWindows
 827 } -body {
 828     set x ok
 829     option add *t.class T5
 830     option add *T5.Visual {grayscale 8}
 831     toplevel .t -width 300 -height 200 -bg #434343
 832     wm geometry .t +0+0
 833     update
 834     option clear
 835     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
 836 } -cleanup {
 837     deleteWindows
 838 } -result {1 {grayscale 8}}
 839 test frame-3.21 {TkCreateFrame procedure} -constraints {
 840         defaultPseudocolor8 haveGrayscale8 nonPortable
 841 } -setup {
 842         deleteWindows
 843 } -body {
 844     set x ok
 845     toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
 846     wm geometry .t +0+0
 847     update
 848     colorsFree .t 131 131 131
 849 } -cleanup {
 850     deleteWindows
 851 } -result {1}
 852 if {[testConstraint defaultPseudocolor8]} {
 853     destroy .t1
 854 }
 855
 856 test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
 857         deleteWindows
 858 } -body {
 859     toplevel .t
 860     wm geometry .t +0+0
 861     update
 862     set result "[winfo reqwidth .t] [winfo reqheight .t]"
 863     frame .t.f -bg red
 864     pack .t.f
 865     update
 866     lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
 867 } -cleanup {
 868     deleteWindows
 869 } -result {200 200 1 1}
 870 test frame-3.23 {TkCreateFrame procedure} -setup {
 871     deleteWindows
 872 } -body {
 873     frame .f -gorp glob
 874 } -returnCodes error -result {unknown option "-gorp"}
 875 test frame-3.24 {TkCreateFrame procedure} -setup {
 876     deleteWindows
 877 } -body {
 878     toplevel .t -width 300 -height 200 -colormap new -bogus option
 879     wm geometry .t +0+0
 880 } -returnCodes error -result {unknown option "-bogus"}
 881
 882
 883 test frame-4.1 {TkCreateFrame procedure} -setup {
 884         deleteWindows
 885 } -body {
 886     catch {frame .f -gorp glob}
 887     winfo exists .f
 888 } -result 0
 889 test frame-4.2 {TkCreateFrame procedure} -setup {
 890         deleteWindows
 891 } -body {
 892     list [frame .f -width 200 -height 100] [winfo exists .f]
 893 } -cleanup {
 894     deleteWindows
 895 } -result {.f 1}
 896
 897
 898 frame .f -highlightcolor black
 899 test frame-5.1 {FrameWidgetCommand procedure} -body {
 900     .f
 901 } -returnCodes error -result {wrong # args: should be ".f option ?arg ...?"}
 902 test frame-5.2 {FrameWidgetCommand procedure, cget option} -body {
 903     .f cget
 904 } -returnCodes error -result {wrong # args: should be ".f cget option"}
 905 test frame-5.3 {FrameWidgetCommand procedure, cget option} -body {
 906     .f cget a b
 907 } -returnCodes error -result {wrong # args: should be ".f cget option"}
 908 test frame-5.4 {FrameWidgetCommand procedure, cget option} -body {
 909     .f cget -gorp
 910 } -returnCodes error -result {unknown option "-gorp"}
 911 test frame-5.5 {FrameWidgetCommand procedure, cget option} -body {
 912     .f cget -highlightcolor
 913 } -result {black}
 914 test frame-5.6 {FrameWidgetCommand procedure, cget option} -body {
 915     .f cget -screen
 916 } -returnCodes error -result {unknown option "-screen"}
 917 test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup {
 918     destroy .t
 919 } -body {
 920     toplevel .t
 921     .t cget -screen
 922 } -cleanup {
 923     destroy .t
 924 } -returnCodes ok -match glob -result *
 925
 926 test frame-5.8 {FrameWidgetCommand procedure, configure option} -body {
 927     llength [.f configure]
 928 } -result {18}
 929 test frame-5.9 {FrameWidgetCommand procedure, configure option} -body {
 930     .f configure -gorp
 931 } -returnCodes error -result {unknown option "-gorp"}
 932 test frame-5.10 {FrameWidgetCommand procedure, configure option} -body {
 933     .f configure -gorp bogus
 934 } -returnCodes error -result {unknown option "-gorp"}
 935 test frame-5.11 {FrameWidgetCommand procedure, configure option} -body {
 936     .f configure -width 200 -height
 937 } -returnCodes error -result {value for "-height" missing}
 938 test frame-5.12 {FrameWidgetCommand procedure} -body {
 939     .f swizzle
 940 } -returnCodes error -result {bad option "swizzle": must be cget or configure}
 941 test frame-5.13 {FrameWidgetCommand procedure, configure option} -body {
 942     llength [. configure]
 943 } -result {21}
 944 destroy .f
 945
 946 test frame-6.1 {ConfigureFrame procedure} -setup {
 947         deleteWindows
 948 } -body {
 949     frame .f -width 150
 950     list [winfo reqwidth .f] [winfo reqheight .f]
 951 } -cleanup {
 952     deleteWindows
 953 } -result {150 1}
 954 test frame-6.2 {ConfigureFrame procedure} -setup {
 955         deleteWindows
 956 } -body {
 957     frame .f -height 97
 958     list [winfo reqwidth .f] [winfo reqheight .f]
 959 } -cleanup {
 960     deleteWindows
 961 } -result {1 97}
 962 test frame-6.3 {ConfigureFrame procedure} -setup {
 963         deleteWindows
 964 } -body {
 965     frame .f
 966     set result {}
 967     lappend result [winfo reqwidth .f] [winfo reqheight .f]
 968     .f configure -width 100 -height 180
 969     lappend result [winfo reqwidth .f] [winfo reqheight .f]
 970     .f configure -width 0 -height 0
 971     lappend result [winfo reqwidth .f] [winfo reqheight .f]
 972 } -cleanup {
 973     deleteWindows
 974 } -result {1 1 100 180 100 180}
 975
 976 test frame-7.1 {FrameEventProc procedure} -setup {
 977         deleteWindows
 978 } -body {
 979     frame .frame2
 980     set result [info commands .frame2]
 981     destroy .frame2
 982     lappend result [info commands .frame2]
 983 } -result {.frame2 {}}
 984 test frame-7.2 {FrameEventProc procedure} -setup {
 985         deleteWindows
 986     set x {}
 987 } -body {
 988     frame .f1 -bg #543210
 989     rename .f1 .f2
 990     lappend x [winfo children .]
 991     lappend x [.f2 cget -bg]
 992     destroy .f1
 993     lappend x [info command .f*] [winfo children .]
 994 } -cleanup {
 995     deleteWindows
 996 } -result {.f1 #543210 {} {}}
 997
 998 test frame-8.1 {FrameCmdDeletedProc procedure} -setup {
 999         deleteWindows
1000 } -body {
1001     frame .f1
1002     rename .f1 {}
1003     list [info command .f*] [winfo children .]
1004 } -cleanup {
1005     deleteWindows
1006 } -result {{} {}}
1007 test frame-8.2 {FrameCmdDeletedProc procedure} -setup {
1008         deleteWindows
1009 } -body {
1010     toplevel .f1 -menu .m
1011     wm geometry .f1 +0+0
1012     update
1013     rename .f1 {}
1014     update
1015     list [info command .f*] [winfo children .]
1016 } -cleanup {
1017     deleteWindows
1018 } -result {{} {}}
1019 #
1020 # This one fails with the dash-patch!!!! Still don't know why  :-(
1021 #
1022 #test frame-8.3 {FrameCmdDeletedProc procedure} -setup {
1023 #    eval destroy [winfo children .]
1024 #    deleteWindows
1025 #} -body {
1026 #    toplevel .f1 -menu .m
1027 #    wm geometry .f1 +0+0
1028 #    menu .m
1029 #    update
1030 #    rename .f1 {}
1031 #    update
1032 #    list [info command .f*] [winfo children .]
1033 #} -cleanup {
1034 #    eval destroy [winfo children .]
1035 #    deleteWindows
1036 #} -result {{} .m}
1037
1038 test frame-9.1 {MapFrame procedure} -setup {
1039         deleteWindows
1040 } -body {
1041     toplevel .t -width 100 -height 400
1042     wm geometry .t +0+0
1043     set result [winfo ismapped .t]
1044     update idletasks
1045     lappend result [winfo ismapped .t]
1046 } -cleanup {
1047     deleteWindows
1048 } -result {0 1}
1049 test frame-9.2 {MapFrame procedure} -setup {
1050         deleteWindows
1051 } -body {
1052     toplevel .t -width 100 -height 400
1053     wm geometry .t +0+0
1054     destroy .t
1055     update
1056     winfo exists .t
1057 } -result {0}
1058 test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup {
1059         deleteWindows
1060 } -body {
1061     toplevel .t2 -width 200 -height 200
1062     wm geometry .t2 +0+0
1063     tkwait visibility .t2
1064     toplevel .t -width 100 -height 400
1065     wm geometry .t +0+0
1066     frame .t2.f -width 50 -height 50
1067     bind .t2.f <Configure> {destroy .t}
1068     pack .t2.f -side top
1069     update idletasks
1070     winfo exists .t
1071 } -cleanup {
1072     deleteWindows
1073 } -result {0}
1074
1075
1076 test frame-10.1 {frame widget vs hidden commands} -setup {
1077         deleteWindows
1078 } -body {
1079     set l [interp hidden]
1080     frame .t
1081     interp hide {} .t
1082     destroy .t
1083     set res1 [list [winfo children .] [interp hidden]]
1084     set res2 [list {} $l]
1085     expr {$res1 eq $res2}
1086 } -result 1
1087
1088
1089 test frame-11.1 {TkInstallFrameMenu} -setup {
1090         deleteWindows
1091 } -body {
1092     menu .m1
1093     .m1 add cascade -menu .m1.system
1094     menu .m1.system -tearoff 0
1095     .m1.system add command -label foo
1096     toplevel .t -menu .m1
1097 } -cleanup {
1098     deleteWindows
1099 } -result {.t}
1100 test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup {
1101         deleteWindows
1102 } -body {
1103     catch {rename foo {}}
1104     menu .m1
1105     .m1 add cascade -menu .m1.system
1106     menu .m1.system -tearoff 0
1107     .m1.system add command -label foo
1108     toplevel .t
1109     rename .t foo
1110 } -cleanup {
1111     deleteWindows
1112 } -result {}
1113
1114
1115 test frame-12.1 {FrameWorldChanged procedure} -setup {
1116         deleteWindows
1117 } -body {
1118     # Test -bd -padx and -pady
1119     frame .f -borderwidth 2 -padx 3 -pady 4
1120     place .f -x 0 -y 0 -width 40 -height 40
1121     pack [frame .f.f] -fill both -expand 1
1122     update
1123     list [winfo x .f.f] [winfo y .f.f] [winfo width .f.f] [winfo height .f.f]
1124 } -cleanup {
1125     deleteWindows
1126 } -result {5 6 30 28}
1127 test frame-12.2 {FrameWorldChanged procedure} -setup {
1128         deleteWindows
1129 } -body {
1130     # Test all -labelanchor positions
1131     set font {helvetica 12}
1132     labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \
1133             -text "Mupp"
1134     set fh [expr {[font metrics $font -linespace] + 2 - 3}]
1135     set fw [expr {[font measure $font "Mupp"] + 2 - 3}]
1136     if {$fw < 0} {set fw 0}
1137     if {$fh < 0} {set fh 0}
1138     place .f -x 0 -y 0 -width 100 -height 100
1139     pack [frame .f.f] -fill both -expand 1
1140
1141     set result {}
1142     foreach lp {nw n ne en e es se s sw ws w wn} {
1143         .f configure -labelanchor $lp
1144         update
1145         set expx 5
1146         set expy 6
1147         set expw 90
1148         set exph 88
1149         switch -glob $lp {
1150             n* {incr expy $fh ; incr exph -$fh}
1151             s* {incr exph -$fh}
1152             w* {incr expx $fw ; incr expw -$fw}
1153             e* {incr expw -$fw}
1154         }
1155         lappend result [expr {\
1156                 [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\
1157                 [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
1158     }
1159     return $result
1160 } -cleanup {
1161     deleteWindows
1162 } -result {1 1 1 1 1 1 1 1 1 1 1 1}
1163 test frame-12.3 {FrameWorldChanged procedure} -setup {
1164         deleteWindows
1165         update idletasks
1166 } -body {
1167     # Check reaction on font change
1168     font create myfont -family courier -size 10
1169     labelframe .f -font myfont -text Mupp
1170     place .f -x 0 -y 0 -width 40 -height 40
1171     pack [frame .f.f] -fill both -expand 1
1172     if {[tk windowingsystem] eq "aqua"} {
1173         update idletasks
1174     } else {
1175         update
1176     }
1177     set h1 [font metrics myfont -linespace]
1178     set y1 [winfo y .f.f]
1179     font configure myfont -size 20
1180     if {[tk windowingsystem] eq "aqua"} {
1181         update idletasks
1182     } else {
1183         update
1184     }
1185     set h2 [font metrics myfont -linespace]
1186     set y2 [winfo y .f.f]
1187     expr {($h2 - $h1) - ($y2 - $y1)}
1188 } -cleanup {
1189     deleteWindows
1190     font delete myfont
1191 } -result {0}
1192
1193
1194 test frame-13.1 {labelframe configuration options} -setup {
1195         deleteWindows
1196 } -body {
1197     labelframe .f -class NewFrame
1198     .f configure -class
1199 } -cleanup {
1200     deleteWindows
1201 } -result {-class class Class Labelframe NewFrame}
1202 test frame-13.2 {labelframe configuration options} -setup {
1203     deleteWindows
1204 } -body {
1205     labelframe .f -class NewFrame
1206     .f configure -class Different
1207 } -cleanup {
1208     deleteWindows
1209 } -returnCodes error -result {can't modify -class option after widget is created}
1210 test frame-13.3 {labelframe configuration options} -setup {
1211         deleteWindows
1212 } -body {
1213     labelframe .f -colormap new
1214 } -cleanup {
1215     deleteWindows
1216 } -result {.f}
1217 test frame-13.4 {labelframe configuration options} -setup {
1218         deleteWindows
1219 } -body {
1220     labelframe .f -visual default
1221 } -cleanup {
1222     deleteWindows
1223 } -result {.f}
1224 test frame-13.5 {labelframe configuration options} -setup {
1225         deleteWindows
1226 } -body {
1227     labelframe .f -screen bogus
1228 } -cleanup {
1229     deleteWindows
1230 } -returnCodes error -result {unknown option "-screen"}
1231 test frame-13.6 {labelframe configuration options} -setup {
1232         deleteWindows
1233 } -body {
1234     labelframe .f -container true
1235 } -cleanup {
1236     deleteWindows
1237 } -result {.f}
1238 test frame-13.7 {labelframe configuration options} -setup {
1239     deleteWindows
1240 } -body {
1241     labelframe .f -container true
1242     .f configure -container
1243 } -cleanup {
1244     deleteWindows
1245 } -result {-container container Container 0 1}
1246 test frame-13.8 {labelframe configuration options} -setup {
1247         deleteWindows
1248 } -body {
1249      labelframe .f -container bogus
1250 } -cleanup {
1251     deleteWindows
1252 } -returnCodes error -result {expected boolean value but got "bogus"}
1253 test frame-13.9 {labelframe configuration options} -setup {
1254         deleteWindows
1255 } -body {
1256     labelframe .f
1257     .f configure -container 1
1258 } -cleanup {
1259     deleteWindows
1260 } -returnCodes error -result {can't modify -container option after widget is created}
1261
1262 destroy .f
1263 labelframe .f
1264 test frame-13.10 {labelframe configuration options} -body {
1265     .f configure -background #ff0000
1266     lindex [.f configure -background] 4
1267 } -cleanup {
1268     .f configure -background [lindex [.f configure -background] 3]
1269 } -result {#ff0000}
1270 test frame-13.11 {labelframe configuration options} -body {
1271         .f configure -background non-existent
1272 } -returnCodes error -result {unknown color name "non-existent"}
1273 test frame-13.12 {labelframe configuration options} -body {
1274     .f configure -bd 4
1275     lindex [.f configure -bd] 4
1276 } -cleanup {
1277     .f configure -bd [lindex [.f configure -bd] 3]
1278 } -result {4}
1279 test frame-13.13 {labelframe configuration options} -body {
1280         .f configure -bd badValue
1281 } -returnCodes error -result {bad screen distance "badValue"}
1282 test frame-13.14 {labelframe configuration options} -body {
1283     .f configure -bg #00ff00
1284     lindex [.f configure -bg] 4
1285 } -cleanup {
1286     .f configure -bg [lindex [.f configure -bg] 3]
1287 } -result {#00ff00}
1288 test frame-13.15 {labelframe configuration options} -body {
1289         .f configure -bg non-existent
1290 } -returnCodes error -result {unknown color name "non-existent"}
1291 test frame-13.16 {labelframe configuration options} -body {
1292     .f configure -borderwidth 1.3
1293     lindex [.f configure -borderwidth] 4
1294 } -cleanup {
1295     .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
1296 } -result {1}
1297 test frame-13.17 {labelframe configuration options} -body {
1298         .f configure -borderwidth badValue
1299 } -returnCodes error -result {bad screen distance "badValue"}
1300 test frame-13.18 {labelframe configuration options} -body {
1301     .f configure -cursor arrow
1302     lindex [.f configure -cursor] 4
1303 } -cleanup {
1304     .f configure -cursor [lindex [.f configure -cursor] 3]
1305 } -result {arrow}
1306 test frame-13.19 {labelframe configuration options} -body {
1307         .f configure -cursor badValue
1308 } -returnCodes error -result {bad cursor spec "badValue"}
1309 test frame-13.20 {labelframe configuration options} -body {
1310     .f configure -fg #0000ff
1311     lindex [.f configure -fg] 4
1312 } -cleanup {
1313     .f configure -fg [lindex [.f configure -fg] 3]
1314 } -result {#0000ff}
1315 test frame-13.21 {labelframe configuration options} -body {
1316         .f configure -fg non-existent
1317 } -returnCodes error -result {unknown color name "non-existent"}
1318 test frame-13.22 {labelframe configuration options} -body {
1319     .f configure -font {courier 8}
1320     lindex [.f configure -font] 4
1321 } -cleanup {
1322     .f configure -font [lindex [.f configure -font] 3]
1323 } -result {courier 8}
1324 test frame-13.23 {labelframe configuration options} -body {
1325     .f configure -foreground #ff0000
1326     lindex [.f configure -foreground] 4
1327 } -cleanup {
1328     .f configure -foreground [lindex [.f configure -foreground] 3]
1329 } -result {#ff0000}
1330 test frame-13.24 {labelframe configuration options} -body {
1331         .f configure -foreground non-existent
1332 } -returnCodes error -result {unknown color name "non-existent"}
1333 test frame-13.25 {labelframe configuration options} -body {
1334     .f configure -height 100
1335     lindex [.f configure -height] 4
1336 } -cleanup {
1337     .f configure -height [lindex [.f configure -height] 3]
1338 } -result {100}
1339 test frame-13.26 {labelframe configuration options} -body {
1340         .f configure -height not_a_number
1341 } -returnCodes error -result {bad screen distance "not_a_number"}
1342 test frame-13.27 {labelframe configuration options} -body {
1343     .f configure -highlightbackground #112233
1344     lindex [.f configure -highlightbackground] 4
1345 } -cleanup {
1346     .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
1347 } -result {#112233}
1348 test frame-13.28 {labelframe configuration options} -body {
1349         .f configure -highlightbackground ugly
1350 } -returnCodes error -result {unknown color name "ugly"}
1351 test frame-13.29 {labelframe configuration options} -body {
1352     .f configure -highlightcolor #123456
1353     lindex [.f configure -highlightcolor] 4
1354 } -cleanup {
1355     .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
1356 } -result {#123456}
1357 test frame-13.30 {labelframe configuration options} -body {
1358         .f configure -highlightcolor non-existent
1359 } -returnCodes error -result {unknown color name "non-existent"}
1360 test frame-13.31 {labelframe configuration options} -body {
1361     .f configure -highlightthickness 6
1362     lindex [.f configure -highlightthickness] 4
1363 } -cleanup {
1364     .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
1365 } -result {6}
1366 test frame-13.32 {labelframe configuration options} -body {
1367         .f configure -highlightthickness badValue
1368 } -returnCodes error -result {bad screen distance "badValue"}
1369 test frame-13.33 {labelframe configuration options} -body {
1370     .f configure -labelanchor se
1371     lindex [.f configure -labelanchor] 4
1372 } -cleanup {
1373     .f configure -labelanchor [lindex [.f configure -labelanchor] 3]
1374 } -result {se}
1375 test frame-13.34 {labelframe configuration options} -body {
1376         .f configure -labelanchor badValue
1377 } -returnCodes error -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}
1378 test frame-13.35 {labelframe configuration options} -body {
1379     .f configure -padx 3
1380     lindex [.f configure -padx] 4
1381 } -cleanup {
1382     .f configure -padx [lindex [.f configure -padx] 3]
1383 } -result {3}
1384 test frame-13.36 {labelframe configuration options} -body {
1385         .f configure -padx badValue
1386 } -returnCodes error -result {bad screen distance "badValue"}
1387 test frame-13.37 {labelframe configuration options} -body {
1388     .f configure -pady 4
1389     lindex [.f configure -pady] 4
1390 } -cleanup {
1391     .f configure -pady [lindex [.f configure -pady] 3]
1392 } -result {4}
1393 test frame-13.38 {labelframe configuration options} -body {
1394         .f configure -pady badValue
1395 } -returnCodes error -result {bad screen distance "badValue"}
1396 test frame-13.39 {labelframe configuration options} -body {
1397     .f configure -relief ridge
1398     lindex [.f configure -relief] 4
1399 } -cleanup {
1400     .f configure -relief [lindex [.f configure -relief] 3]
1401 } -result {ridge}
1402 test frame-13.40 {labelframe configuration options} -body {
1403         .f configure -relief badValue
1404 } -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
1405 test frame-13.41 {labelframe configuration options} -body {
1406     .f configure -takefocus {any string}
1407     lindex [.f configure -takefocus] 4
1408 } -cleanup {
1409     .f configure -takefocus [lindex [.f configure -takefocus] 3]
1410 } -result {any string}
1411 test frame-13.42 {labelframe configuration options} -body {
1412     .f configure -text {any string}
1413     lindex [.f configure -text] 4
1414 } -cleanup {
1415     .f configure -text [lindex [.f configure -text] 3]
1416 } -result {any string}
1417 test frame-13.43 {labelframe configuration options} -body {
1418     .f configure -width 32
1419     lindex [.f configure -width] 4
1420 } -cleanup {
1421     .f configure -width [lindex [.f configure -width] 3]
1422 } -result {32}
1423 test frame-13.44 {labelframe configuration options} -body {
1424         .f configure -width badValue
1425 } -returnCodes error -result {bad screen distance "badValue"}
1426 destroy .f
1427
1428
1429 test frame-14.1 {labelframe labelwidget option} -setup {
1430         deleteWindows
1431 } -body {
1432     # Test that label is moved in stacking order
1433     label .l -text Mupp -font {helvetica 8}
1434     labelframe .f -labelwidget .l
1435     pack .f
1436     frame .f.f -width 50 -height 50
1437     pack .f.f
1438     update
1439     list [winfo children .] [winfo width .f] \
1440         [expr {[winfo height .f] - [winfo height .l]}]
1441 } -cleanup {
1442     deleteWindows
1443 } -result {{.f .l} 54 52}
1444 test frame-14.2 {labelframe labelwidget option} -setup {
1445         deleteWindows
1446 } -body {
1447     # Test the labelframe's reaction if the label is destroyed
1448     label .l -text Aratherlonglabel
1449     labelframe .f -labelwidget .l
1450     pack .f
1451     label .f.l -text Mupp
1452     pack .f.l
1453     update
1454     set res [list [.f cget -labelwidget]]
1455     lappend res [expr {[winfo width .f] - [winfo width .l]}]
1456     destroy .l
1457     lappend res [.f cget -labelwidget]
1458     update
1459     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
1460 } -cleanup {
1461     deleteWindows
1462 } -result {.l 12 {} 4}
1463 test frame-14.3 {labelframe labelwidget option} -setup {
1464         deleteWindows
1465 } -body {
1466     # Test the labelframe's reaction if the label is stolen
1467     label .l -text Aratherlonglabel
1468     labelframe .f -labelwidget .l
1469     pack .f
1470     label .f.l -text Mupp
1471     pack .f.l
1472     update
1473     set res [list [.f cget -labelwidget]]
1474     lappend res [expr {[winfo width .f] - [winfo width .l]}]
1475     pack .l
1476     lappend res [.f cget -labelwidget]
1477     update
1478     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
1479 } -cleanup {
1480     deleteWindows
1481 } -result {.l 12 {} 4}
1482 test frame-14.4 {labelframe labelwidget option} -setup {
1483         deleteWindows
1484 } -body {
1485     # Test the label's reaction if the labelframe is destroyed
1486     label .l -text Mupp
1487     labelframe .f -labelwidget .l
1488     pack .f
1489     update
1490     set res [list [winfo manager .l]]
1491     destroy .f
1492     lappend res [winfo manager .l]
1493 } -cleanup {
1494     deleteWindows
1495 } -result {labelframe {}}
1496 test frame-14.5 {labelframe labelwidget option} -setup {
1497         deleteWindows
1498 } -body {
1499     # Test that the labelframe reacts on changes in label
1500     label .l -text Aratherlonglabel
1501     labelframe .f -labelwidget .l
1502     pack .f
1503     label .f.l -text Mupp
1504     pack .f.l
1505     update
1506     set first [winfo width .f]
1507     set res [expr {[winfo width .f] - [winfo width .l]}]
1508     .l configure -text Shorter
1509     update
1510     lappend res [expr {[winfo width .f] - [winfo width .l]}]
1511     lappend res [expr {[winfo width .f] < $first}]
1512     .l configure -text Alotlongerthananytimebefore
1513     update
1514     lappend res [expr {[winfo width .f] - [winfo width .l]}]
1515     lappend res [expr {[winfo width .f] > $first}]
1516 } -cleanup {
1517     deleteWindows
1518 } -result {12 12 1 12 1}
1519 test frame-14.6 {labelframe labelwidget option} -setup {
1520         deleteWindows
1521 } -body {
1522     # Destroying a labelframe with a child label caused a crash
1523     # when not handling mapping of the label correctly.
1524     # This test does not test anything directly, it's just ment
1525     # to catch if the same mistake is made again.
1526     labelframe .f
1527     pack .f
1528     label .f.l -text Mupp
1529     .f configure -labelwidget .f.l
1530     update
1531 } -cleanup {
1532     deleteWindows
1533 } -result {}
1534 deleteWindows
1535 rename eatColors {}
1536 rename colorsFree {}
1537
1538 # cleanup
1539 cleanupTests
1540 return
1541
1542
1543
1544