diff options
Diffstat (limited to 'tests/frame.test')
| -rw-r--r-- | tests/frame.test | 346 |
1 files changed, 315 insertions, 31 deletions
diff --git a/tests/frame.test b/tests/frame.test index d7245f7..74768e4 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -1,15 +1,15 @@ -# This file is a Tcl script to test out the "frame" and "toplevel" -# commands of Tk. It is organized in the standard fashion for Tcl +# This file is a Tcl script to test out the "frame", "labelframe" and +# "toplevel" commands of Tk. It is organized in the standard fashion for Tcl # tests. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1996 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 namespace import ::tcltest::* -eval tcltest::configure $argv +tcltest::configure {*}$argv tcltest::loadTestedCommands tcltest::testConstraint x11 [expr {[tk windowingsystem] eq "x11"}] @@ -173,7 +173,7 @@ test frame-1.12 {frame configuration options} -setup { lappend opts [lindex $opt 0] [lindex $opt 4] } } - eval frame .g $opts + frame .g {*}$opts } -cleanup { destroy .f .g deleteWindows @@ -198,7 +198,7 @@ test frame-1.15 {frame configuration options} -body { } -result 4 test frame-1.16 {frame configuration options} -body { .f configure -bd badValue -} -returnCodes error -result {bad screen distance "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 @@ -216,7 +216,7 @@ test frame-1.19 {frame configuration options} -body { } -result 1 test frame-1.20 {frame configuration options} -body { .f configure -borderwidth badValue -} -returnCodes error -result {bad screen distance "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 @@ -234,7 +234,7 @@ test frame-1.23 {frame configuration options} -body { } -result 100 test frame-1.24 {frame configuration options} -body { .f configure -height not_a_number -} -returnCodes error -result {bad screen distance "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 @@ -261,7 +261,7 @@ test frame-1.29 {frame configuration options} -body { } -result 6 test frame-1.30 {frame configuration options} -body { .f configure -highlightthickness badValue -} -returnCodes error -result {bad screen distance "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 @@ -270,7 +270,7 @@ test frame-1.31 {frame configuration options} -body { } -result 3 test frame-1.32 {frame configuration options} -body { .f configure -padx badValue -} -returnCodes error -result {bad screen distance "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 @@ -279,7 +279,7 @@ test frame-1.33 {frame configuration options} -body { } -result 4 test frame-1.34 {frame configuration options} -body { .f configure -pady badValue -} -returnCodes error -result {bad screen distance "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 @@ -303,7 +303,7 @@ test frame-1.38 {frame configuration options} -body { } -result 32 test frame-1.39 {frame configuration options} -body { .f configure -width badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} destroy .f test frame-2.1 {toplevel configuration options} -setup { @@ -480,7 +480,7 @@ test frame-2.19 {toplevel configuration options} -setup { lappend opts [lindex $opt 0] [lindex $opt 4] } } - eval toplevel .g $opts + toplevel .g {*}$opts } -cleanup { destroy .f .g deleteWindows @@ -503,7 +503,7 @@ test frame-2.22 {toplevel configuration options} -body { } -result 4 test frame-2.23 {toplevel configuration options} -body { .t configure -bd badValue -} -returnCodes error -result {bad screen distance "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 @@ -517,7 +517,7 @@ test frame-2.26 {toplevel configuration options} -body { } -result 1 test frame-2.27 {toplevel configuration options} -body { .t configure -borderwidth badValue -} -returnCodes error -result {bad screen distance "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 @@ -531,7 +531,7 @@ test frame-2.30 {toplevel configuration options} -body { } -result 100 test frame-2.31 {toplevel configuration options} -body { .t configure -height not_a_number -} -returnCodes error -result {bad screen distance "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 @@ -545,21 +545,21 @@ test frame-2.34 {toplevel configuration options} -body { } -result 3 test frame-2.35 {toplevel configuration options} -body { .t configure -highlightthickness badValue -} -returnCodes error -result {bad screen distance "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 {bad screen distance "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 {bad screen distance "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 @@ -573,7 +573,7 @@ test frame-2.42 {toplevel configuration options} -body { } -result 32 test frame-2.43 {toplevel configuration options} -body { .t configure -width badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} destroy .t test frame-3.1 {TkCreateFrame procedure} -returnCodes error -body { @@ -900,7 +900,7 @@ test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup { } -returnCodes ok -match glob -result * test frame-5.8 {FrameWidgetCommand procedure, configure option} -body { optnames [.f configure] -} -result {-background -bd -bg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -padx -pady -relief -takefocus -visual -width} +} -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"} @@ -915,7 +915,7 @@ test frame-5.12 {FrameWidgetCommand procedure} -body { } -returnCodes error -result {bad option "swizzle": must be cget or configure} test frame-5.13 {FrameWidgetCommand procedure, configure option} -body { optnames [. configure] -} -result {-background -bd -bg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -menu -padx -pady -relief -screen -takefocus -use -visual -width} +} -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} destroy .f test frame-6.1 {ConfigureFrame procedure} -setup { @@ -1233,7 +1233,7 @@ test frame-13.12 {labelframe configuration options} -body { } -result 4 test frame-13.13 {labelframe configuration options} -body { .f configure -bd badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} test frame-13.14 {labelframe configuration options} -body { .f configure -bg #00ff00 lindex [.f configure -bg] 4 @@ -1251,7 +1251,7 @@ test frame-13.16 {labelframe configuration options} -body { } -result 1 test frame-13.17 {labelframe configuration options} -body { .f configure -borderwidth badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} test frame-13.18 {labelframe configuration options} -body { .f configure -cursor arrow lindex [.f configure -cursor] 4 @@ -1293,7 +1293,7 @@ test frame-13.25 {labelframe configuration options} -body { } -result 100 test frame-13.26 {labelframe configuration options} -body { .f configure -height not_a_number -} -returnCodes error -result {bad screen distance "not_a_number"} +} -returnCodes error -result {expected screen distance but got "not_a_number"} test frame-13.27 {labelframe configuration options} -body { .f configure -highlightbackground #112233 lindex [.f configure -highlightbackground] 4 @@ -1320,7 +1320,7 @@ test frame-13.31 {labelframe configuration options} -body { } -result 6 test frame-13.32 {labelframe configuration options} -body { .f configure -highlightthickness badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} test frame-13.33 {labelframe configuration options} -body { .f configure -labelanchor se lindex [.f configure -labelanchor] 4 @@ -1338,7 +1338,7 @@ test frame-13.35 {labelframe configuration options} -body { } -result 3 test frame-13.36 {labelframe configuration options} -body { .f configure -padx badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} test frame-13.37 {labelframe configuration options} -body { .f configure -pady 4 lindex [.f configure -pady] 4 @@ -1347,7 +1347,7 @@ test frame-13.37 {labelframe configuration options} -body { } -result 4 test frame-13.38 {labelframe configuration options} -body { .f configure -pady badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} test frame-13.39 {labelframe configuration options} -body { .f configure -relief ridge lindex [.f configure -relief] 4 @@ -1377,7 +1377,7 @@ test frame-13.43 {labelframe configuration options} -body { } -result 32 test frame-13.44 {labelframe configuration options} -body { .f configure -width badValue -} -returnCodes error -result {bad screen distance "badValue"} +} -returnCodes error -result {expected screen distance but got "badValue"} destroy .f test frame-14.1 {labelframe labelwidget option} -setup { @@ -1485,6 +1485,290 @@ test frame-14.6 {labelframe labelwidget option} -setup { } -cleanup { deleteWindows } -result {} + +test frame-15.1 {TIP 262: frame background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + frame .f -width 100 -height 100 + pack .f + list [image inuse gorp] [.f configure -backgroundimage gorp;update] \ + [image inuse gorp] [winfo width .f] [winfo height .f] +} -cleanup { + image delete gorp + deleteWindows +} -result {0 {} 1 100 100} +test frame-15.2 {TIP 262: frame background images} -setup { + deleteWindows + catch {rename gorp ""} +} -body { + frame .f -width 100 -height 100 + pack .f + update + .f configure -backgroundimage gorp +} -returnCodes error -cleanup { + deleteWindows +} -result {image "gorp" doesn't exist} +test frame-15.3 {TIP 262: frame background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + frame .f -width 100 -height 100 -backgroundimage gorp + pack .f + .f configure -tile yes + update + list [.f cget -bgimg] [.f cget -tile] +} -cleanup { + image delete gorp + deleteWindows +} -result {gorp 1} +test frame-15.4 {TIP 262: frame background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + frame .f -width 100 -height 100 -backgroundimage gorp + pack .f + .f configure -tile yes + update + gorp put red -to 15 15 20 20 + update + list [.f cget -bgimg] [.f cget -tile] +} -cleanup { + image delete gorp + deleteWindows +} -result {gorp 1} +test frame-15.5 {TIP 262: frame background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 + set result {} +} -body { + frame .f -width 100 -height 100 -backgroundimage gorp + pack .f + .f configure -tile yes + update + image delete gorp + update + set result [list [.f cget -bgimg] [.f cget -tile]] + image create photo gorp -width 250 -height 250 + update + lappend result [.f cget -backgroundimage] +} -cleanup { + catch {image delete gorp} + deleteWindows +} -result {gorp 1 gorp} +test frame-15.6 {TIP 262: frame background images} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 100 -height 100 -bgimg gorp] + update idletasks; update + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15}} +test frame-15.6a {TIP 262: frame background images (offsets)} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 10 -height 10 -bgimg gorp] + update idletasks; update + # On MacOS must wait for the test image display procedure to run. + set timer [after 300 {lappend result "timedout"}] + while {"timedout" ni $result && + "gorp display 10 2 10 10" ni $result} { + vwait result + } + after cancel $timer + update idletasks; update + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 10 2 10 10}} +test frame-15.7 {TIP 262: frame background images} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1] + update idletasks; update + # On MacOS must wait for the test image display procedure to run. + set timer [after 300 {lappend result "timedout"}] + while {"timedout" ni $result && + "gorp display 0 0 20 10" ni $result} { + vwait result + } + after cancel $timer + if {[lindex $result end] eq "timedout"} { + return [lreplace $result end end] + } + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}} +test frame-15.7a {TIP 262: frame background images (offsets)} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1] + update idletasks; update + # On MacOS must wait for the test image display procedure to run. + set timer [after 300 {lappend result "timedout"}] + while {"timedout" ni $result && + "gorp display 0 0 18 8" ni $result} { + vwait result + } + after cancel $timer + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 8} {gorp display 0 0 18 15} {gorp display 0 0 18 8}} +test frame-15.7b {TIP 262: frame background images (offsets)} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2] + update idletasks; update + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 6} {gorp display 0 0 16 15} {gorp display 0 0 16 6}} +test frame-15.7c {TIP 262: frame background images (offsets)} -setup { + deleteWindows + set result {} + . configure -width 200 -height 200 +} -constraints testImageType -body { + image create test gorp -variable result + pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1] + update idletasks; update + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 4} {gorp display 0 0 14 15} {gorp display 0 0 14 4}} +test frame-15.8 {TIP 262: toplevel background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + toplevel .t -width 100 -height 100 + update + # Used to verify that setting a background image doesn't change the widget size + set w [winfo width .t] + set h [winfo height .t] + list [image inuse gorp] [.t configure -backgroundimage gorp;update] \ + [image inuse gorp] \ + [expr {$w-[winfo width .t]}] [expr {$h-[winfo height .t]}] +} -cleanup { + image delete gorp + deleteWindows +} -result {0 {} 1 0 0} +test frame-15.9 {TIP 262: toplevel background images} -setup { + deleteWindows + catch {rename gorp ""} +} -body { + toplevel .t -width 100 -height 100 + update + .t configure -backgroundimage gorp +} -returnCodes error -cleanup { + deleteWindows +} -result {image "gorp" doesn't exist} +test frame-15.10 {TIP 262: toplevel background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes + update + list [.t cget -bgimg] [.t cget -tile] +} -cleanup { + image delete gorp + deleteWindows +} -result {gorp 1} +test frame-15.11 {TIP 262: toplevel background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 +} -body { + toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes + update + gorp put red -to 15 15 20 20 + update + list [.t cget -bgimg] [.t cget -tile] +} -cleanup { + image delete gorp + deleteWindows +} -result {gorp 1} +test frame-15.12 {TIP 262: toplevel background images} -setup { + deleteWindows + image create photo gorp -width 10 -height 10 + gorp put black -to 2 2 7 7 + set result {} +} -body { + toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes + update + image delete gorp + update + set result [list [.t cget -bgimg] [.t cget -tile]] + image create photo gorp -width 250 -height 250 + update + lappend result [.t cget -backgroundimage] +} -cleanup { + catch {image delete gorp} + deleteWindows +} -result {gorp 1 gorp} +test frame-15.13 {TIP 262: toplevel background images} -setup { + deleteWindows + set result {} +} -constraints testImageType -body { + image create test gorp -variable result + toplevel .t -width 100 -height 100 -bgimg gorp + wm overrideredirect .t 1; # Reduce trouble from window managers + update idletasks; update + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15}} +test frame-15.14 {TIP 262: toplevel background images} -setup { + deleteWindows + set result {} +} -constraints testImageType -body { + image create test gorp -variable result + toplevel .t -width 50 -height 25 -bgimg gorp -tile 1 + wm overrideredirect .t 1; # Reduce trouble from window managers + update idletasks; update + # On MacOS must wait for the test image display procedure to run. + set timer [after 300 {lappend result "timedout"}] + while {"timedout" ni $result && + "gorp display 0 0 20 10" ni $result} { + vwait result + } + after cancel $timer + return [uniq $result] +} -cleanup { + deleteWindows + catch {image delete gorp} +} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}} + +# cleanup deleteWindows apply {cmds {foreach cmd $cmds {rename $cmd {}}}} { eatColors colorsFree uniq optnames |