# This file is a Tcl script to test out the "frame", "labelframe" and

# "toplevel" commands of Tk.

#

# Copyright © 1994 The Regents of the University of California.

# Copyright © 1994-1996 Sun Microsystems, Inc.

# Copyright © 1998-1999 Scriptics Corporation.

# All rights reserved.

#

# TESTFILE INITIALIZATION

#

package require tcltest 2.2; # needed in mode -singleproc 0

# Load the main script main.tcl, which takes care of:

# - setup for the application and the root window

# - importing commands from the tcltest namespace

# - loading of the testutils mechanism along with its utility procs

# - loading of Tk specific test constraints (additionally to constraints

# provided by the package tcltest)

source [file join [tcltest::configure -testdir] main.tcl]

# Ensure a pristine initial window state

resetWindows

# Import utility procs for specific functional areas

testutils import colors

#

# LOCAL UTILITY PROCS

#

# optnames --

#

# Returns the option names out of a list of option details.

#

# Arguments:

# options - The option detail list.

proc optnames {options} {

lsort [lmap desc $options {lindex $desc 0}]

}

# uniq --

#

# Returns the unique items of a list in the order they first appear.

#

# Arguments:

# list - The list to uniq-ify.

proc uniq {list} {

set d {}

foreach item $list {

dict set d $item {}

}

return [dict keys $d]

}

#

# TESTS

#

test frame-1.1 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -class NewFrame

.f configure -class

} -cleanup {

deleteWindows

} -result {-class class Class Frame NewFrame}

test frame-1.2 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -class NewFrame

.f configure -class Different

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -class option after widget is created}

test frame-1.3 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -colormap new

.f configure -colormap

} -cleanup {

deleteWindows

} -result {-colormap colormap Colormap {} new}

test frame-1.4 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -colormap new

.f configure -colormap .

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -colormap option after widget is created}

test frame-1.5 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -visual default

.f configure -visual

} -cleanup {

deleteWindows

} -result {-visual visual Visual {} default}

test frame-1.6 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -visual default

.f configure -visual best

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -visual option after widget is created}

test frame-1.7 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -screen bogus

} -cleanup {

deleteWindows

} -returnCodes error -result {unknown option "-screen"}

test frame-1.8 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -container true

} -cleanup {

deleteWindows

} -result {.f}

test frame-1.9 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -container true

.f configure -container

} -cleanup {

deleteWindows

} -result {-container container Container 0 1}

test frame-1.10 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f -container bogus

} -cleanup {

deleteWindows

} -returnCodes error -result {expected boolean value but got "bogus"}

test frame-1.11 {frame configuration options} -setup {

deleteWindows

} -body {

frame .f

.f configure -container 1

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -container option after widget is created}

test frame-1.12 {frame configuration options} -setup {

deleteWindows

} -body {

# Make sure all options can be set to the default value

frame .f

set opts {}

foreach opt [.f configure] {

if {[llength $opt] == 5} {

lappend opts [lindex $opt 0] [lindex $opt 4]

}

}

frame .g {*}$opts

} -cleanup {

destroy .f .g

deleteWindows

} -result .g

#

# COMMON TEST SETUP

#

destroy .f

frame .f

test frame-1.13 {frame configuration options} -body {

.f configure -background #ff0000

lindex [.f configure -background] 4

} -cleanup {

.f configure -background [lindex [.f configure -background] 3]

} -result "#ff0000"

test frame-1.14 {frame configuration options} -body {

.f configure -background non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-1.15 {frame configuration options} -body {

.f configure -bd 4

lindex [.f configure -bd] 4

} -cleanup {

.f configure -bd [lindex [.f configure -bd] 3]

} -result 4

test frame-1.16 {frame configuration options} -body {

.f configure -bd badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-1.17 {frame configuration options} -body {

.f configure -bg #00ff00

lindex [.f configure -bg] 4

} -cleanup {

.f configure -bg [lindex [.f configure -bg] 3]

} -result "#00ff00"

test frame-1.18 {frame configuration options} -body {

.f configure -bg non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-1.19 {frame configuration options} -body {

.f configure -borderwidth 1.3

lindex [.f configure -borderwidth] 4

} -cleanup {

.f configure -borderwidth [lindex [.f configure -borderwidth] 3]

} -result 1.3

test frame-1.20 {frame configuration options} -body {

.f configure -borderwidth badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-1.21 {frame configuration options} -body {

.f configure -cursor arrow

lindex [.f configure -cursor] 4

} -cleanup {

.f configure -cursor [lindex [.f configure -cursor] 3]

} -result {arrow}

test frame-1.22 {frame configuration options} -body {

.f configure -cursor badValue

} -returnCodes error -result {bad cursor spec "badValue"}

test frame-1.23 {frame configuration options} -body {

.f configure -height 100

lindex [.f configure -height] 4

} -cleanup {

.f configure -height [lindex [.f configure -height] 3]

} -result 100

test frame-1.24 {frame configuration options} -body {

.f configure -height not_a_number

} -returnCodes error -result {expected screen distance but got "not_a_number"}

test frame-1.25 {frame configuration options} -body {

.f configure -highlightbackground #112233

lindex [.f configure -highlightbackground] 4

} -cleanup {

.f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]

} -result "#112233"

test frame-1.26 {frame configuration options} -body {

.f configure -highlightbackground ugly

} -returnCodes error -result {unknown color name "ugly"}

test frame-1.27 {frame configuration options} -body {

.f configure -highlightcolor #123456

lindex [.f configure -highlightcolor] 4

} -cleanup {

.f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]

} -result "#123456"

test frame-1.28 {frame configuration options} -body {

.f configure -highlightcolor non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-1.29 {frame configuration options} -body {

.f configure -highlightthickness 6

lindex [.f configure -highlightthickness] 4

} -cleanup {

.f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]

} -result 6

test frame-1.30 {frame configuration options} -body {

.f configure -highlightthickness badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-1.31 {frame configuration options} -body {

.f configure -padx 3

lindex [.f configure -padx] 4

} -cleanup {

.f configure -padx [lindex [.f configure -padx] 3]

} -result 3

test frame-1.32 {frame configuration options} -body {

.f configure -padx badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-1.33 {frame configuration options} -body {

.f configure -pady 4

lindex [.f configure -pady] 4

} -cleanup {

.f configure -pady [lindex [.f configure -pady] 3]

} -result 4

test frame-1.34 {frame configuration options} -body {

.f configure -pady badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-1.35 {frame configuration options} -body {

.f configure -relief ridge

lindex [.f configure -relief] 4

} -cleanup {

.f configure -relief [lindex [.f configure -relief] 3]

} -result {ridge}

test frame-1.36 {frame configuration options} -returnCodes error -body {

.f configure -relief badValue

} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test frame-1.37 {frame configuration options} -body {

.f configure -takefocus {any string}

lindex [.f configure -takefocus] 4

} -cleanup {

.f configure -takefocus [lindex [.f configure -takefocus] 3]

} -result {any string}

test frame-1.38 {frame configuration options} -body {

.f configure -width 32

lindex [.f configure -width] 4

} -cleanup {

.f configure -width [lindex [.f configure -width] 3]

} -result 32

test frame-1.39 {frame configuration options} -body {

.f configure -width badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

#

# COMMON TEST CLEANUP

#

destroy .f

test frame-2.1 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -class NewClass

wm geometry .t +0+0

.t configure -class

} -cleanup {

deleteWindows

} -result {-class class Class Toplevel NewClass}

test frame-2.2 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -class NewClass

wm geometry .t +0+0

.t configure -class Another

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -class option after widget is created}

test frame-2.3 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -colormap new

wm geometry .t +0+0

.t configure -colormap

} -cleanup {

deleteWindows

} -result {-colormap colormap Colormap {} new}

test frame-2.4 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -colormap new

wm geometry .t +0+0

.t configure -colormap .

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -colormap option after widget is created}

test frame-2.5 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

.t configure -container 1

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -container option after widget is created}

test frame-2.6 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

catch {.t configure -container 1}

.t configure -container

} -cleanup {

deleteWindows

} -result {-container container Container 0 0}

test frame-2.7 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -colormap bogus

} -cleanup {

deleteWindows

} -returnCodes error -result {bad window path name "bogus"}

test frame-2.8 {toplevel configuration options} -constraints win -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

.t configure -use 0x44022

} -cleanup {

deleteWindows

} -returnCodes error -result {window "0x44022" does not exist}

test frame-2.9 {toplevel configuration options} -constraints win -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

catch {.t configure -use 0x44022}

.t configure -use

} -cleanup {

deleteWindows

} -result {-use use Use {} {}}

test frame-2.10 {toplevel configuration options} -constraints nonwin -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

.t configure -use 0x44022

} -cleanup {

deleteWindows

} -returnCodes error -result {can't modify -use option after widget is created}

test frame-2.11 {toplevel configuration options} -constraints nonwin -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100

wm geometry .t +0+0

catch {.t configure -use 0x44022}

.t configure -use

} -cleanup {

deleteWindows

} -result {-use use Use {} {}}

test frame-2.12 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -visual default

wm geometry .t +0+0

.t configure -visual

} -cleanup {

deleteWindows

} -result {-visual visual Visual {} default}

test frame-2.13 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -visual default

wm geometry .t +0+0

.t configure -visual best

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -visual option after widget is created}

test frame-2.14 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -visual who_knows?

} -returnCodes error -cleanup {

deleteWindows

} -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}

test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -screen $env(DISPLAY)

wm geometry .t +0+0

.t configure -screen

} -cleanup {

deleteWindows

} -result [expr {[tcltest::testConstraint haveDISPLAY]?[list -screen screen Screen {} $env(DISPLAY)]:""}]

test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -screen $env(DISPLAY)

wm geometry .t +0+0

.t configure -screen another

} -returnCodes error -cleanup {

deleteWindows

} -result {can't modify -screen option after widget is created}

test frame-2.17 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -width 200 -height 100 -screen bogus

} -cleanup {

deleteWindows

} -returnCodes error -result {couldn't connect to display "bogus"}

test frame-2.18 {toplevel configuration options} -setup {

deleteWindows

} -body {

toplevel .t -container 1 -width 300 -height 120

wm geometry .t +0+0

toplevel .x -container 1 -use [winfo id .t]

} -returnCodes error -cleanup {

deleteWindows

} -result {windows cannot have both the -use and the -container option set}

test frame-2.19 {toplevel configuration options} -setup {

deleteWindows

set opts {}

} -body {

# Make sure all options can be set to the default value

toplevel .f

foreach opt [.f configure] {

if {[llength $opt] == 5} {

lappend opts [lindex $opt 0] [lindex $opt 4]

}

}

toplevel .g {*}$opts

} -cleanup {

destroy .f .g

deleteWindows

} -result .g

#

# COMMON TEST SETUP

#

destroy .t

toplevel .t -width 300 -height 150

wm geometry .t +0+0

update

test frame-2.20 {toplevel configuration options} -body {

.t configure -background #ff0000

lindex [.t configure -background] 4

} -result "#ff0000"

test frame-2.21 {toplevel configuration options} -body {

.t configure -background non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-2.22 {toplevel configuration options} -body {

.t configure -bd 4

lindex [.t configure -bd] 4

} -result 4

test frame-2.23 {toplevel configuration options} -body {

.t configure -bd badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-2.24 {toplevel configuration options} -body {

.t configure -bg #00ff00

lindex [.t configure -bg] 4

} -result "#00ff00"

test frame-2.25 {toplevel configuration options} -body {

.t configure -bg non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-2.26 {toplevel configuration options} -body {

.t configure -borderwidth 1.3

lindex [.t configure -borderwidth] 4

} -result 1.3

test frame-2.27 {toplevel configuration options} -body {

.t configure -borderwidth badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-2.28 {toplevel configuration options} -body {

.t configure -cursor arrow

lindex [.t configure -cursor] 4

} -result {arrow}

test frame-2.29 {toplevel configuration options} -body {

.t configure -cursor badValue

} -returnCodes error -result {bad cursor spec "badValue"}

test frame-2.30 {toplevel configuration options} -body {

.t configure -height 100

lindex [.t configure -height] 4

} -result 100

test frame-2.31 {toplevel configuration options} -body {

.t configure -height not_a_number

} -returnCodes error -result {expected screen distance but got "not_a_number"}

test frame-2.32 {toplevel configuration options} -body {

.t configure -highlightcolor #123456

lindex [.t configure -highlightcolor] 4

} -result "#123456"

test frame-2.33 {toplevel configuration options} -body {

.t configure -highlightcolor non-existent

} -returnCodes error -result {unknown color name "non-existent"}

test frame-2.34 {toplevel configuration options} -body {

.t configure -highlightthickness 3

lindex [.t configure -highlightthickness] 4

} -result 3

test frame-2.35 {toplevel configuration options} -body {

.t configure -highlightthickness badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-2.36 {toplevel configuration options} -body {

.t configure -padx 3

lindex [.t configure -padx] 4

} -result 3

test frame-2.37 {toplevel configuration options} -body {

.t configure -padx badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-2.38 {toplevel configuration options} -body {

.t configure -pady 4

lindex [.t configure -pady] 4

} -result 4

test frame-2.39 {toplevel configuration options} -body {

.t configure -pady badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

test frame-2.40 {toplevel configuration options} -body {

.t configure -relief ridge

lindex [.t configure -relief] 4

} -result {ridge}

test frame-2.41 {toplevel configuration options} -returnCodes error -body {

.t configure -relief badValue

} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}

test frame-2.42 {toplevel configuration options} -body {

.t configure -width 32

lindex [.t configure -width] 4

} -result 32

test frame-2.43 {toplevel configuration options} -body {

.t configure -width badValue

} -returnCodes error -result {expected screen distance but got "badValue"}

#

# COMMON TEST CLEANUP

#

destroy .t

test frame-3.1 {TkCreateFrame procedure} -returnCodes error -body {

frame

} -result {wrong # args: should be "frame pathName ?-option value ...?"}

test frame-3.2 {TkCreateFrame procedure} -setup {

deleteWindows

frame .f

} -body {

.f configure -class

} -cleanup {

deleteWindows

} -result {-class class Class Frame Frame}

test frame-3.3 {TkCreateFrame procedure} -setup {

deleteWindows

toplevel .t

wm geometry .t +0+0

} -body {

.t configure -class

} -cleanup {

deleteWindows

} -result {-class class Class Toplevel Toplevel}

test frame-3.4 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

toplevel .t -width 350 -class NewClass -bg black -visual default -height 90

wm geometry .t +0+0

update

list [lindex [.t configure -width] 4] \

[lindex [.t configure -background] 4] \

[lindex [.t configure -height] 4]

} -cleanup {

deleteWindows

} -result {350 black 90}

# Be sure that the -class, -colormap, and -visual options are processed

# before configuring the widget.

test frame-3.5 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

option add *NewFrame.background #123456

frame .f -class NewFrame

lindex [.f configure -background] 4

} -cleanup {

deleteWindows

option clear

} -result {#123456}

test frame-3.7 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

option add *NewFrame.background #332211

option add *f.class NewFrame

frame .f

list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]

} -cleanup {

deleteWindows

option clear

} -result {NewFrame #332211}

test frame-3.8 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

option add *Silly.background #122334

option add *f.Class Silly

frame .f

list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]

} -cleanup {

deleteWindows

option clear

} -result {Silly #122334}

test frame-3.9 {TkCreateFrame procedure, -use option} -constraints {

unix

} -setup {

deleteWindows

} -body {

toplevel .t -container 1 -width 300 -height 120

wm geometry .t +0+0

toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green

tkwait visibility .x

list [expr {[winfo rootx .x] - [winfo rootx .t]}] \

[expr {[winfo rooty .x] - [winfo rooty .t]}] \

[winfo width .t] [winfo height .t]

} -cleanup {

deleteWindows

} -result {0 0 140 300}

test frame-3.10 {TkCreateFrame procedure, -use option} -constraints {

unix

} -setup {

deleteWindows

} -body {

toplevel .t -container 1 -width 300 -height 120

wm geometry .t +0+0

update

option add *x.use [winfo id .t]

toplevel .x -width 140 -height 300 -bg green

tkwait visibility .x

update

list [expr {[winfo rootx .x] - [winfo rootx .t]}] \

[expr {[winfo rooty .x] - [winfo rooty .t]}] \

[winfo width .t] [winfo height .t]

} -cleanup {

destroy .t

option clear

} -result {0 0 140 300}

#

# COMMON TEST SETUP

#

# The tests below require specific display characteristics (i.e. that they are

# run on a pseudocolor display of depth 8). Even so, they are non-portable:

# some machines don't seem to ever run out of colors.

if {[testConstraint defaultPseudocolor8]} {

eatColors .t1

}

test frame-3.11 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -width 300 -height 200 -bg #475601

wm geometry .t +0+0

update

colorsFree .t

} -cleanup {

destroy .t

} -result 0

test frame-3.12 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -width 300 -height 200 -bg #475601 -colormap new

wm geometry .t +0+0

update

colorsFree .t

} -cleanup {

destroy .t

} -result 1

test frame-3.13 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

option add *t.class Toplevel2

option add *Toplevel2.colormap new

toplevel .t -width 300 -height 200 -bg #475601

wm geometry .t +0+0

update

option clear

colorsFree .t

} -cleanup {

destroy .t

} -result 1

test frame-3.14 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

option add *t.class Toplevel3

option add *Toplevel3.Colormap new

toplevel .t -width 300 -height 200 -bg #475601 -colormap new

wm geometry .t +0+0

update

option clear

colorsFree .t

} -cleanup {

destroy .t

} -result 1

test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {

defaultPseudocolor8 unix nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -container 1 -width 300 -height 120

wm geometry .t +0+0

toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new

tkwait visibility .x

list [colorsFree .t] [colorsFree .x]

} -cleanup {

destroy .t

} -result {0 1}

test frame-3.16 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -width 300 -height 200 -bg #475601 -visual default

wm geometry .t +0+0

update

colorsFree .t

} -cleanup {

destroy .t

} -result 0

test frame-3.17 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -width 300 -height 200 -bg #475601 -visual default \

-colormap new

wm geometry .t +0+0

update

colorsFree .t

} -cleanup {

destroy .t

} -result 1

test frame-3.18 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 haveGrayscale8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343

wm geometry .t +0+0

update

colorsFree .t 131 131 131

} -cleanup {

destroy .t

} -result 1

test frame-3.19 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 haveGrayscale8 nonPortable

} -setup {

destroy .t

} -body {

option add *t.class T4

option add *T4.visual {grayscale 8}

toplevel .t -width 300 -height 200 -bg #434343

wm geometry .t +0+0

update

option clear

list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]

} -cleanup {

destroy .t

} -result {1 {grayscale 8}}

test frame-3.20 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 haveGrayscale8 nonPortable

} -setup {

destroy .t

} -body {

option add *t.class T5

option add *T5.Visual {grayscale 8}

toplevel .t -width 300 -height 200 -bg #434343

wm geometry .t +0+0

update

option clear

list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]

} -cleanup {

destroy .t

} -result {1 {grayscale 8}}

test frame-3.21 {TkCreateFrame procedure} -constraints {

defaultPseudocolor8 haveGrayscale8 nonPortable

} -setup {

destroy .t

} -body {

toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343

wm geometry .t +0+0

update

colorsFree .t 131 131 131

} -cleanup {

destroy .t

} -result 1

#

# COMMON TEST CLEANUP

#

if {[testConstraint defaultPseudocolor8]} {

destroy .t1

}

test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {

deleteWindows

} -body {

toplevel .t

wm geometry .t +0+0

update

set result "[winfo reqwidth .t] [winfo reqheight .t]"

frame .t.f -bg red

pack .t.f

update

lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]

} -cleanup {

deleteWindows

} -result {200 200 1 1}

test frame-3.23 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

frame .f -gorp glob

} -returnCodes error -result {unknown option "-gorp"}

test frame-3.24 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

toplevel .t -width 300 -height 200 -colormap new -bogus option

wm geometry .t +0+0

} -returnCodes error -result {unknown option "-bogus"}

test frame-4.1 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

catch {frame .f -gorp glob}

winfo exists .f

} -result 0

test frame-4.2 {TkCreateFrame procedure} -setup {

deleteWindows

} -body {

list [frame .f -width 200 -height 100] [winfo exists .f]

} -cleanup {

deleteWindows

} -result {.f 1}

#

# COMMON TEST SETUP

#

frame .f -highlightcolor black

test frame-5.1 {FrameWidgetCommand procedure} -body {

.f

} -returnCodes error -result {wrong # args: should be ".f option ?arg ...?"}

test frame-5.2 {FrameWidgetCommand procedure, cget option} -body {

.f cget

} -returnCodes error -result {wrong # args: should be ".f cget option"}

test frame-5.3 {FrameWidgetCommand procedure, cget option} -body {

.f cget a b

} -returnCodes error -result {wrong # args: should be ".f cget option"}

test frame-5.4 {FrameWidgetCommand procedure, cget option} -body {

.f cget -gorp

} -returnCodes error -result {unknown option "-gorp"}

test frame-5.5 {FrameWidgetCommand procedure, cget option} -body {

.f cget -highlightcolor

} -result {black}

test frame-5.6 {FrameWidgetCommand procedure, cget option} -body {

.f cget -screen

} -returnCodes error -result {unknown option "-screen"}

test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup {

destroy .t

} -body {

toplevel .t

.t cget -screen

} -cleanup {

destroy .t

} -returnCodes ok -match glob -result *

test frame-5.8 {FrameWidgetCommand procedure, configure option} -body {

optnames [.f configure]

} -result {-background -backgroundimage -bd -bg -bgimg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -padx -pady -relief -takefocus -tile -visual -width}

test frame-5.9 {FrameWidgetCommand procedure, configure option} -body {

.f configure -gorp

} -returnCodes error -result {unknown option "-gorp"}

test frame-5.10 {FrameWidgetCommand procedure, configure option} -body {

.f configure -gorp bogus

} -returnCodes error -result {unknown option "-gorp"}

test frame-5.11 {FrameWidgetCommand procedure, configure option} -body {

.f configure -width 200 -height

} -returnCodes error -result {value for "-height" missing}

test frame-5.12 {FrameWidgetCommand procedure} -body {

.f swizzle

} -returnCodes error -result {bad option "swizzle": must be cget or configure}

test frame-5.13 {FrameWidgetCommand procedure, configure option} -body {

optnames [. configure]

} -result {-background -backgroundimage -bd -bg -bgimg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -menu -padx -pady -relief -screen -takefocus -tile -use -visual -width}

#

# COMMON TEST CLEANUP

#

destroy .f

test frame-6.1 {ConfigureFrame procedure} -setup {

deleteWindows

} -body {

frame .f -width 150

list [winfo reqwidth .f] [winfo reqheight .f]

} -cleanup {

deleteWindows

} -result {150 1}

test frame-6.2 {ConfigureFrame procedure} -setup {

deleteWindows

} -body {

frame .f -height 97

list [winfo reqwidth .f] [winfo reqheight .f]

} -cleanup {

deleteWindows

} -result {1 97}

test frame-6.3 {ConfigureFrame procedure} -setup {

deleteWindows

} -body {

frame .f

set result {}

lappend result [winfo reqwidth .f] [winfo reqheight .f]

.f configure -width 100 -height 180

lappend result [winfo reqwidth .f] [winfo reqheight .f]

.f configure -width 0 -height 0

lappend result [winfo reqwidth .f] [winfo reqheight .f]

} -cleanup {

deleteWindows

} -result {1 1 100 180 100 180}

test frame-7.1 {FrameEventProc procedure} -setup {

deleteWindows

} -body {

frame .frame2

set result [info commands .frame2]

destroy .frame2

lappend result [info commands .frame2]

} -result {.frame2 {}}

test frame-7.2 {FrameEventProc procedure} -setup {

deleteWindows

set x {}

} -body {

frame .f1 -bg #543210

rename .f1 .f2

lappend x [winfo children .]

lappend x [.f2 cget -bg]

destroy .f1

lappend x [info command .f*] [winfo children .]

} -cleanup {

deleteWindows

} -result {.f1 #543210 {} {}}

test frame-8.1 {FrameCmdDeletedProc procedure} -setup {

deleteWindows

} -body {

frame .f1

rename .f1 {}

list [info command .f*] [winfo children .]

} -cleanup {

deleteWindows

} -result {{} {}}

test frame-8.2 {FrameCmdDeletedProc procedure} -setup {

deleteWindows

} -body {

toplevel .f1 -menu .m

wm geometry .f1 +0+0

update

rename .f1 {}