diff options
Diffstat (limited to 'tests/border.test')
| -rw-r--r-- | tests/border.test | 160 |
1 files changed, 99 insertions, 61 deletions
diff --git a/tests/border.test b/tests/border.test index db1a5f7..0348959 100644 --- a/tests/border.test +++ b/tests/border.test @@ -5,51 +5,62 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: border.test,v 1.7 2004/12/04 00:04:40 dkf Exp $ +# RCS: @(#) $Id: border.test,v 1.8 2008/07/22 11:55:57 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -if {[testConstraint pseudocolor8]} { - toplevel .t -visual {pseudocolor 8} -colormap new - wm geom .t +0+0 -} - -test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} testborder { +test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} -constraints { + testborder +} -body { set x orange lindex $x 0 - destroy .b1 button .b1 -bg $x -text .b1 lindex $x 0 testborder orange -} {{1 0}} -test border-1.3 {Tk_AllocBorderFromObj - discard stale border} testborder { +} -cleanup { + destroy .b1 +} -result {{1 0}} +test border-1.2 {Tk_AllocBorderFromObj - discard stale border} -constraints { + testborder +} -setup { + set result {} +} -body { set x orange - destroy .b1 .b2 button .b1 -bg $x -text First destroy .b1 - set result {} lappend result [testborder orange] button .b2 -bg $x -text Second lappend result [testborder orange] -} {{} {{1 1}}} -test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} testborder { - set x orange +} -cleanup { destroy .b1 .b2 - button .b1 -bg $x -text First +} -result {{} {{1 1}}} +test border-1.3 {Tk_AllocBorderFromObj - reuse existing border} -constraints { + testborder +} -setup { set result {} +} -body { + set x orange + button .b1 -bg $x -text First lappend result [testborder orange] button .b2 -bg $x -text Second pack .b1 .b2 -side top lappend result [testborder orange] -} {{{1 1}} {{2 1}}} -test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor8 testborder} { +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} +test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 + set result {} +} -body { set x purple - destroy .b1 .b2 .t.b button .b1 -bg $x -text First pack .b1 -side top - set result {} lappend result [testborder purple] button .t.b -bg $x -text Second pack .t.b -side top @@ -57,18 +68,24 @@ test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor button .b2 -bg $x -text Third pack .b2 -side top lappend result [testborder purple] -} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} +} -cleanup { + destroy .b1 .b2 .t +} -result {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} -test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} { +test border-2.1 {Tk_Free3DBorder - reference counts} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 + set result {} +} -body { set x purple - destroy .b1 .b2 .t.b button .b1 -bg $x -text First pack .b1 -side top button .t.b -bg $x -text Second pack .t.b -side top button .b2 -bg $x -text Third pack .b2 -side top - set result {} lappend result [testborder purple] destroy .b1 lappend result [testborder purple] @@ -76,11 +93,18 @@ test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} { lappend result [testborder purple] destroy .t.b lappend result [testborder purple] -} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} -test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder} { - destroy .b .t.b .t2 .t3 +} -cleanup { + destroy .b1 .b2 .t +} -result {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} +test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 toplevel .t2 -visual {pseudocolor 8} -colormap new toplevel .t3 -visual {pseudocolor 8} -colormap new + set result {} +} -body { set x purple button .b -bg $x -text .b1 button .t.b1 -bg $x -text .t.b1 @@ -92,7 +116,6 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder button .t3.b2 -bg $x -text .t3.b2 button .t3.b3 -bg $x -text .t3.b3 button .t3.b4 -bg $x -text .t3.b4 - set result {} lappend result [testborder purple] destroy .t2 lappend result [testborder purple] @@ -102,17 +125,21 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder lappend result [testborder purple] destroy .t lappend result [testborder purple] -} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} +} -cleanup { + destroy .b .t2 .t3 .t +} -result {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} -test border-4.1 {FreeBorderObjProc} testborder { - destroy .b +test border-3.1 {FreeBorderObjProc} -constraints { + testborder +} -setup { + set result {} +} -body { set x [format purple] button .b -bg $x -text .b1 set y [format purple] .b configure -bg $y set z [format purple] .b configure -bg $z - set result {} lappend result [testborder purple] set x red lappend result [testborder purple] @@ -121,42 +148,53 @@ test border-4.1 {FreeBorderObjProc} testborder { destroy .b lappend result [testborder purple] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} -catch {destroy .b} -button .b -test border-5.1 {Tk_GetReliefFromObj} { - .b configure -relief flat +test border-4.1 {Tk_GetReliefFromObj} -body { + button .b -relief flat .b cget -relief -} {flat} -test border-5.2 {Tk_GetReliefFromObj} { - .b configure -relief groove +} -cleanup { + destroy .b +} -result {flat} +test border-4.2 {Tk_GetReliefFromObj} -body { + button .b -relief groove .b cget -relief -} {groove} -test border-5.3 {Tk_GetReliefFromObj} { - .b configure -relief raised +} -cleanup { + destroy .b +} -result {groove} +test border-4.3 {Tk_GetReliefFromObj} -body { + button .b -relief raised .b cget -relief -} {raised} -test border-5.4 {Tk_GetReliefFromObj} { - .b configure -relief ridge +} -cleanup { + destroy .b +} -result {raised} +test border-4.4 {Tk_GetReliefFromObj} -body { + button .b -relief ridge .b cget -relief -} {ridge} -test border-5.5 {Tk_GetReliefFromObj} { - .b configure -relief solid +} -cleanup { + destroy .b +} -result {ridge} +test border-4.5 {Tk_GetReliefFromObj} -body { + button .b -relief solid .b cget -relief -} {solid} -test border-5.6 {Tk_GetReliefFromObj} { - .b configure -relief sunken +} -cleanup { + destroy .b +} -result {solid} +test border-4.6 {Tk_GetReliefFromObj} -body { + button .b -relief sunken .b cget -relief -} {sunken} -test border-5.7 {Tk_GetReliefFromObj - error} { - list [catch {.b configure -relief upanddown} msg] $msg -} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}} +} -cleanup { + destroy .b +} -result {sunken} +test border-4.7 {Tk_GetReliefFromObj - error} -body { + button .b -relief upanddown +} -cleanup { + destroy .b +} -returnCodes error -result {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken} -if {[testConstraint pseudocolor8]} { - destroy .t -} # cleanup cleanupTests |