diff options
| -rw-r--r-- | tests/bitmap.test | 84 | ||||
| -rw-r--r-- | tests/border.test | 160 | ||||
| -rw-r--r-- | tests/button.test | 4414 | ||||
| -rw-r--r-- | tests/entry.test | 3702 | ||||
| -rw-r--r-- | tests/spinbox.test | 4087 |
5 files changed, 9821 insertions, 2626 deletions
diff --git a/tests/bitmap.test b/tests/bitmap.test index 3186cad..9a27b55 100644 --- a/tests/bitmap.test +++ b/tests/bitmap.test @@ -6,57 +6,73 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bitmap.test,v 1.6 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: bitmap.test,v 1.7 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 -test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap { +test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} -constraints { + testbitmap +} -body { set x gray25 - lindex $x 0 - destroy .b1 - button .b1 -bitmap $x + lindex $x 0 + button .b -bitmap $x lindex $x 0 testbitmap gray25 -} {{1 0}} -test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap { +} -cleanup { + destroy .b +} -result {{1 0}} +test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x gray25 - destroy .b1 .b2 button .b1 -bitmap $x destroy .b1 - set result {} lappend result [testbitmap gray25] button .b2 -bitmap $x lappend result [testbitmap gray25] -} {{} {{1 1}}} -test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap { - set x gray25 +} -cleanup { destroy .b1 .b2 - button .b1 -bitmap $x +} -result {{} {{1 1}}} +test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} -constraints { + testbitmap +} -setup { set result {} +} -body { + set x gray25 + button .b1 -bitmap $x lappend result [testbitmap gray25] button .b2 -bitmap $x pack .b1 .b2 -side top lappend result [testbitmap gray25] -} {{{1 1}} {{2 1}}} +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} -test bitmap-2.1 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap bad_name} msg] $msg -} {1 {bitmap "bad_name" not defined}} -test bitmap-2.2 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap @xyzzy} msg] $msg -} {1 {error reading bitmap file "xyzzy"}} +test bitmap-2.1 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap bad_name +} -cleanup { + destroy .b1 +} -returnCodes error -result {bitmap "bad_name" not defined} +test bitmap-2.2 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap @xyzzy +} -cleanup { + destroy .b1 +} -returnCodes error -result {error reading bitmap file "xyzzy"} -test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { +test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x questhead - destroy .b1 .b2 .b3 button .b1 -bitmap $x button .b3 -bitmap $x button .b2 -bitmap $x - set result {} lappend result [testbitmap questhead] destroy .b1 lappend result [testbitmap questhead] @@ -64,10 +80,13 @@ test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { lappend result [testbitmap questhead] destroy .b3 lappend result [testbitmap questhead] -} {{{3 1}} {{2 1}} {{1 1}} {}} +} -cleanup { + destroy .b1 .b2 .b3 ;# destroying just in case +} -result {{{3 1}} {{2 1}} {{1 1}} {}} -test bitmap-4.1 {FreeBitmapObjProc} testbitmap { - destroy .b +test bitmap-4.1 {FreeBitmapObjProc} -constraints { + testbitmap +} -body { set x [format questhead] button .b -bitmap $x set y [format questhead] @@ -83,10 +102,11 @@ test bitmap-4.1 {FreeBitmapObjProc} testbitmap { destroy .b lappend result [testbitmap questhead] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} -destroy .t # cleanup cleanupTests 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 diff --git a/tests/button.test b/tests/button.test index 9d13ce4..abc9315 100644 --- a/tests/button.test +++ b/tests/button.test @@ -7,429 +7,3203 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: button.test,v 1.20 2004/12/07 21:22:19 dgp Exp $ +# RCS: @(#) $Id: button.test,v 1.21 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 + proc bogusTrace args { error "trace aborted" } -catch {unset value} -catch {unset value2} -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. +test button-1.1 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activebackground #012345 + .l cget -activebackground +} -cleanup { + destroy .l +} -result {#012345} +test button-1.2 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activebackground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.3 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activebackground #012345 + .b cget -activebackground +} -cleanup { + destroy .b +} -result {#012345} +test button-1.4 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activebackground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.5 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activebackground #012345 + .c cget -activebackground +} -cleanup { + destroy .c +} -result {#012345} +test button-1.6 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activebackground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.7 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activebackground #012345 + .r cget -activebackground +} -cleanup { + destroy .r +} -result {#012345} +test button-1.8 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activebackground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.9 {configuration option: "activeforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activeforeground #ff0000 + .l cget -activeforeground +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.10 {configuration option: "activeforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activeforeground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.11 {configuration option: "activeforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activeforeground #ff0000 + .b cget -activeforeground +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.12 {configuration option: "activeforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activeforeground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.13 {configuration option: "activeforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activeforeground #ff0000 + .c cget -activeforeground +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.14 {configuration option: "activeforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activeforeground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.15 {configuration option: "activeforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activeforeground #ff0000 + .r cget -activeforeground +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.16 {configuration option: "activeforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activeforeground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.17 {configuration option: "anchor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -anchor nw + .l cget -anchor +} -cleanup { + destroy .l +} -result {nw} +test button-1.18 {configuration option: "anchor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -anchor bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.19 {configuration option: "anchor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -anchor nw + .b cget -anchor +} -cleanup { + destroy .b +} -result {nw} +test button-1.20 {configuration option: "anchor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -anchor bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.21 {configuration option: "anchor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -anchor nw + .c cget -anchor +} -cleanup { + destroy .c +} -result {nw} +test button-1.22 {configuration option: "anchor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -anchor bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.23 {configuration option: "anchor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -anchor nw + .r cget -anchor +} -cleanup { + destroy .r +} -result {nw} +test button-1.24 {configuration option: "anchor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -anchor bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} + +test button-1.25 {configuration option: "background" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -background #ff0000 + .l cget -background +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.26 {configuration option: "background" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -background non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.27 {configuration option: "background" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -background #ff0000 + .b cget -background +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.28 {configuration option: "background" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -background non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.29 {configuration option: "background" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -background #ff0000 + .c cget -background +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.30 {configuration option: "background" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -background non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.31 {configuration option: "background" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -background #ff0000 + .r cget -background +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.32 {configuration option: "background" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -background non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.33 {configuration option: "bd" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bd 4 + .l cget -bd +} -cleanup { + destroy .l +} -result {4} +test button-1.34 {configuration option: "bd" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bd badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.35 {configuration option: "bd" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bd 4 + .b cget -bd +} -cleanup { + destroy .b +} -result {4} +test button-1.36 {configuration option: "bd" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bd badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.37 {configuration option: "bd" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bd 4 + .c cget -bd +} -cleanup { + destroy .c +} -result {4} +test button-1.38 {configuration option: "bd" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bd badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.39 {configuration option: "bd" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bd 4 + .r cget -bd +} -cleanup { + destroy .r +} -result {4} +test button-1.40 {configuration option: "bd" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bd badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} + +test button-1.41 {configuration option: "bg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bg #ff0000 + .l cget -bg +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.42 {configuration option: "bg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bg non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.43 {configuration option: "bg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bg #ff0000 + .b cget -bg +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.44 {configuration option: "bg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bg non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.45 {configuration option: "bg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bg #ff0000 + .c cget -bg +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.46 {configuration option: "bg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bg non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.47 {configuration option: "bg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bg #ff0000 + .r cget -bg +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.48 {configuration option: "bg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bg non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.49 {configuration option: "bitmap" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bitmap questhead + .l cget -bitmap +} -cleanup { + destroy .l +} -result {questhead} +test button-1.50 {configuration option: "bitmap" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bitmap badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.51 {configuration option: "bitmap" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bitmap questhead + .b cget -bitmap +} -cleanup { + destroy .b +} -result {questhead} +test button-1.52 {configuration option: "bitmap" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bitmap badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.53 {configuration option: "bitmap" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bitmap questhead + .c cget -bitmap +} -cleanup { + destroy .c +} -result {questhead} +test button-1.54 {configuration option: "bitmap" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bitmap badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.55 {configuration option: "bitmap" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bitmap questhead + .r cget -bitmap +} -cleanup { + destroy .r +} -result {questhead} +test button-1.56 {configuration option: "bitmap" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bitmap badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bitmap "badValue" not defined} + +test button-1.57 {configuration option: "borderwidth" for label} -setup { + label .l -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -borderwidth 1.3 + .l cget -borderwidth +} -cleanup { + destroy .l +} -result {1.3} +test button-1.58 {configuration option: "borderwidth" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -borderwidth badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.59 {configuration option: "borderwidth" for button} -setup { + button .b -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -borderwidth 1.3 + .b cget -borderwidth +} -cleanup { + destroy .b +} -result {1.3} +test button-1.60 {configuration option: "borderwidth" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -borderwidth badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.61 {configuration option: "borderwidth" for checkbutton} -setup { + checkbutton .c -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -borderwidth 1.3 + .c cget -borderwidth +} -cleanup { + destroy .c +} -result {1.3} +test button-1.62 {configuration option: "borderwidth" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -borderwidth badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.63 {configuration option: "borderwidth" for radiobutton} -setup { + radiobutton .r -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -borderwidth 1.3 + .r cget -borderwidth +} -cleanup { + destroy .r +} -result {1.3} +test button-1.64 {configuration option: "borderwidth" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -borderwidth badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} + +test button-1.65 {configuration option: "command" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -command {set x} + .b cget -command +} -cleanup { + destroy .b +} -result {set x} +test button-1.66 {configuration option: "command" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -command {set x} + .b cget -command +} -cleanup { + destroy .b +} -result {set x} +test button-1.67 {configuration option: "command" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -command {set x} + .c cget -command +} -cleanup { + destroy .c +} -result {set x} +test button-1.68 {configuration option: "command" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -command {set x} + .r cget -command +} -cleanup { + destroy .r +} -result {set x} + +test button-1.69 {configuration option: "compound" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -compound left + .l cget -compound +} -cleanup { + destroy .l +} -result {left} +test button-1.70 {configuration option: "compound" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -compound bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.71 {configuration option: "compound" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -compound left + .b cget -compound +} -cleanup { + destroy .b +} -result {left} +test button-1.72 {configuration option: "compound" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -compound bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.73 {configuration option: "compound" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -compound left + .c cget -compound +} -cleanup { + destroy .c +} -result {left} +test button-1.74 {configuration option: "compound" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -compound bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.75 {configuration option: "compound" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -compound left + .r cget -compound +} -cleanup { + destroy .r +} -result {left} +test button-1.76 {configuration option: "compound" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -compound bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} + +test button-1.77 {configuration option: "cursor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -cursor arrow + .l cget -cursor +} -cleanup { + destroy .l +} -result {arrow} +test button-1.78 {configuration option: "cursor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -cursor badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.79 {configuration option: "cursor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -cursor arrow + .b cget -cursor +} -cleanup { + destroy .b +} -result {arrow} +test button-1.80 {configuration option: "cursor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -cursor badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.81 {configuration option: "cursor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -cursor arrow + .c cget -cursor +} -cleanup { + destroy .c +} -result {arrow} +test button-1.82 {configuration option: "cursor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -cursor badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.83 {configuration option: "cursor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -cursor arrow + .r cget -cursor +} -cleanup { + destroy .r +} -result {arrow} +test button-1.84 {configuration option: "cursor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -cursor badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test button-1.85 {configuration option: "default" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -default active + .b cget -default +} -cleanup { + destroy .b +} -result {active} +test button-1.86 {configuration option: "default" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -default huh? +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad default "huh?": must be active, disabled, or normal} + +test button-1.87 {configuration option: "disabledforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -disabledforeground #00ff00 + .l cget -disabledforeground +} -cleanup { + destroy .l +} -result {#00ff00} +test button-1.88 {configuration option: "disabledforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -disabledforeground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.89 {configuration option: "disabledforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -disabledforeground #00ff00 + .b cget -disabledforeground +} -cleanup { + destroy .b +} -result {#00ff00} +test button-1.90 {configuration option: "disabledforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -disabledforeground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.91 {configuration option: "disabledforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -disabledforeground #00ff00 + .c cget -disabledforeground +} -cleanup { + destroy .c +} -result {#00ff00} +test button-1.92 {configuration option: "disabledforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -disabledforeground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.93 {configuration option: "disabledforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -disabledforeground #00ff00 + .r cget -disabledforeground +} -cleanup { + destroy .r +} -result {#00ff00} +test button-1.94 {configuration option: "disabledforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -disabledforeground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.95 {configuration option: "fg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -fg #110022 + .l cget -fg +} -cleanup { + destroy .l +} -result {#110022} +test button-1.96 {configuration option: "fg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -fg non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.97 {configuration option: "fg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -fg #110022 + .b cget -fg +} -cleanup { + destroy .b +} -result {#110022} +test button-1.98 {configuration option: "fg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -fg non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.99 {configuration option: "fg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -fg #110022 + .c cget -fg +} -cleanup { + destroy .c +} -result {#110022} +test button-1.100 {configuration option: "fg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -fg non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.101 {configuration option: "fg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -fg #110022 + .r cget -fg +} -cleanup { + destroy .r +} -result {#110022} +test button-1.102 {configuration option: "fg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -fg non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.103 {configuration option: "font" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 + pack .l + update +} -body { + .l configure -font {Helvetica -12} + .l cget -font +} -cleanup { + destroy .l +} -result {Helvetica -12} +test button-1.104 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 + pack .l + update +} -body { + .l configure -font {} +} -cleanup { + destroy .l +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.105 {configuration option: "font" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 + pack .b + update +} -body { + .b configure -font {Helvetica -12} + .b cget -font +} -cleanup { + destroy .b +} -result {Helvetica -12} +test button-1.106 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 + pack .b + update +} -body { + .b configure -font {} +} -cleanup { + destroy .b +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.107 {configuration option: "font" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 + pack .c + update +} -body { + .c configure -font {Helvetica -12} + .c cget -font +} -cleanup { + destroy .c +} -result {Helvetica -12} +test button-1.108 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 + pack .c + update +} -body { + .c configure -font {} +} -cleanup { + destroy .c +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.109 {configuration option: "font" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 + pack .r + update +} -body { + .r configure -font {Helvetica -12} + .r cget -font +} -cleanup { + destroy .r +} -result {Helvetica -12} +test button-1.110 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 + pack .r + update +} -body { + .r configure -font {} +} -cleanup { + destroy .r +} -returnCodes {error} -result {font "" doesn't exist} + +test button-1.111 {configuration option: "foreground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -foreground #110022 + .l cget -foreground +} -cleanup { + destroy .l +} -result {#110022} +test button-1.112 {configuration option: "foreground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -foreground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.113 {configuration option: "foreground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -foreground #110022 + .b cget -foreground +} -cleanup { + destroy .b +} -result {#110022} +test button-1.114 {configuration option: "foreground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -foreground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.115 {configuration option: "foreground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -foreground #110022 + .c cget -foreground +} -cleanup { + destroy .c +} -result {#110022} +test button-1.116 {configuration option: "foreground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -foreground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.117 {configuration option: "foreground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -foreground #110022 + .r cget -foreground +} -cleanup { + destroy .r +} -result {#110022} +test button-1.118 {configuration option: "foreground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -foreground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.119 {configuration option: "height" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -height 18 + .l cget -height +} -cleanup { + destroy .l +} -result {18} +test button-1.120 {configuration option: "height" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -height 20.0 +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.121 {configuration option: "height" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -height 18 + .b cget -height +} -cleanup { + destroy .b +} -result {18} +test button-1.122 {configuration option: "height" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -height 20.0 +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.123 {configuration option: "height" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -height 18 + .c cget -height +} -cleanup { + destroy .c +} -result {18} +test button-1.124 {configuration option: "height" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -height 20.0 +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.125 {configuration option: "height" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -height 18 + .r cget -height +} -cleanup { + destroy .r +} -result {18} +test button-1.126 {configuration option: "height" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -height 20.0 +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "20.0"} + +test button-1.127 {configuration option: "highlightbackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightbackground #110022 + .l cget -highlightbackground +} -cleanup { + destroy .l +} -result {#110022} +test button-1.128 {configuration option: "highlightbackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightbackground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.129 {configuration option: "highlightbackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightbackground #110022 + .b cget -highlightbackground +} -cleanup { + destroy .b +} -result {#110022} +test button-1.130 {configuration option: "highlightbackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightbackground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.131 {configuration option: "highlightbackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightbackground #110022 + .c cget -highlightbackground +} -cleanup { + destroy .c +} -result {#110022} +test button-1.132 {configuration option: "highlightbackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightbackground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.133 {configuration option: "highlightbackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightbackground #110022 + .r cget -highlightbackground +} -cleanup { + destroy .r +} -result {#110022} +test button-1.134 {configuration option: "highlightbackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightbackground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.135 {configuration option: "highlightcolor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightcolor #110022 + .l cget -highlightcolor +} -cleanup { + destroy .l +} -result {#110022} +test button-1.136 {configuration option: "highlightcolor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightcolor non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.137 {configuration option: "highlightcolor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightcolor #110022 + .b cget -highlightcolor +} -cleanup { + destroy .b +} -result {#110022} +test button-1.138 {configuration option: "highlightcolor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightcolor non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.139 {configuration option: "highlightcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightcolor #110022 + .c cget -highlightcolor +} -cleanup { + destroy .c +} -result {#110022} +test button-1.140 {configuration option: "highlightcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightcolor non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.141 {configuration option: "highlightcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightcolor #110022 + .r cget -highlightcolor +} -cleanup { + destroy .r +} -result {#110022} +test button-1.142 {configuration option: "highlightcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightcolor non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} -option add *Button.borderWidth 2 -option add *Button.highlightThickness 2 -option add *Button.font {Helvetica -12 bold} +test button-1.143 {configuration option: "highlightthickness" for label} -setup { + label .l -borderwidth 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightthickness 6m + .l cget -highlightthickness +} -cleanup { + destroy .l +} -result {6m} +test button-1.144 {configuration option: "highlightthickness" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightthickness badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.145 {configuration option: "highlightthickness" for button} -setup { + button .b -borderwidth 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightthickness 6m + .b cget -highlightthickness +} -cleanup { + destroy .b +} -result {6m} +test button-1.146 {configuration option: "highlightthickness" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightthickness badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.147 {configuration option: "highlightthickness" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightthickness 6m + .c cget -highlightthickness +} -cleanup { + destroy .c +} -result {6m} +test button-1.148 {configuration option: "highlightthickness" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightthickness badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.149 {configuration option: "highlightthickness" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightthickness 6m + .r cget -highlightthickness +} -cleanup { + destroy .r +} -result {6m} +test button-1.150 {configuration option: "highlightthickness" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightthickness badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} -eval image delete [image names] -if {[testConstraint testImageType]} { +test button-1.151 {configuration option: "image" for label} -constraints { + testImageType +} -setup { image create test image1 -} -label .l -text Label -button .b -text Button -checkbutton .c -text Checkbutton -radiobutton .r -text Radiobutton -pack .l .b .c .r -update -set i 1 -foreach test { - {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-anchor nw nw bogus - {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} - {1 1 1 1}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"} - {1 1 1 1}} - {-bitmap questhead questhead badValue {bitmap "badValue" not defined} - {1 1 1 1}} - {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}} - {-command "set x" {set x} {} {} {0 1 1 1}} - {-compound left left bogus - {bad compound "bogus": must be bottom, center, left, none, right, or top} - {1 1 1 1}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}} - {-default active active huh? - {bad default "huh?": must be active, disabled, or normal} - {0 1 0 0}} - {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"} - {1 1 1 1}} - {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}} - {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}} - {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"} - {1 1 1 1}} - {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"} - {1 1 1 1}} - {-highlightthickness 6m 6m badValue {bad screen distance "badValue"} - {1 1 1 1}} - {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}} - {-indicatoron yes 1 no_way {expected boolean value but got "no_way"} - {0 0 1 1}} - {-justify right right bogus - {bad justification "bogus": must be left, right, or center} - {1 1 1 1}} - {-offrelief flat flat 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {0 0 1 1}} - {-offvalue lousy lousy {} {} {0 0 1 0}} - {-onvalue fantastic fantastic {} {} {0 0 1 0}} - {-overrelief "" "" 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {0 1 1 1}} - {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} - {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} - {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}} - {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}} - {-relief flat flat 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {1 1 1 1}} - {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}} - {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}} - {-state normal normal bogus - {bad state "bogus": must be active, disabled, or normal} - {1 1 1 1}} - {-takefocus "any string" "any string" {} {} {1 1 1 1}} - {-text "Sample text" {Sample text} {} {} {1 1 1 1}} - {-textvariable i i {} {} {1 1 1 1}} - {-tristateimage image1 image1 bogus {image "bogus" doesn't exist} - {0 0 1 1}} - {-tristatevalue unknowable unknowable {} {} {0 0 1 1}} - {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}} - {-value anyString anyString {} {} {0 0 0 1}} - {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}} - {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}} -} { - lassign $test name value okResult badValue badResult classes - foreach w {.l .b .c .r} hasOption $classes { - set classname [winfo class $w] - if {$hasOption} { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType -body " - $w configure $name [list $value] - lindex \[$w configure $name] 4 - " -result $okResult - incr i - if {$badValue ne ""} { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType \ - -body [list $w configure $name $badValue] \ - -returnCodes error -result $badResult - incr i - } - $w configure $name [lindex [$w configure $name] 3] - } else { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType \ - -body [list $w configure $name $value] \ - -returnCodes error -result "unknown option \"$name\"" - incr i - } - } -} -test button-1.$i {configuration options} { - # Additional check to make sure that -selectcolor may be empty in - # checkbox widgets + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -image image1 + .l cget -image +} -cleanup { + destroy .l + image delete image1 +} -result {image1} +test button-1.152 {configuration option: "image" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -image bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.153 {configuration option: "image" for button} -constraints { + testImageType +} -setup { + image create test image1 + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -image image1 + .b cget -image +} -cleanup { + destroy .b + image delete image1 +} -result {image1} +test button-1.154 {configuration option: "image" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -image bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.155 {configuration option: "image" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -image image1 + .c cget -image +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.156 {configuration option: "image" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -image bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.157 {configuration option: "image" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -image image1 + .r cget -image +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.158 {configuration option: "image" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -image bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.159 {configuration option: "indicatoron" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -indicatoron yes + .c cget -indicatoron +} -cleanup { + destroy .c +} -result {1} +test button-1.160 {configuration option: "indicatoron" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -indicatoron no_way +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected boolean value but got "no_way"} +test button-1.161 {configuration option: "indicatoron" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -indicatoron yes + .r cget -indicatoron +} -cleanup { + destroy .r +} -result {1} +test button-1.162 {configuration option: "indicatoron" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -indicatoron no_way +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected boolean value but got "no_way"} + +test button-1.163 {configuration option: "justify" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -justify right + .l cget -justify +} -cleanup { + destroy .l +} -result {right} +test button-1.164 {configuration option: "justify" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -justify bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.165 {configuration option: "justify" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -justify right + .b cget -justify +} -cleanup { + destroy .b +} -result {right} +test button-1.166 {configuration option: "justify" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -justify bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.167 {configuration option: "justify" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -justify right + .c cget -justify +} -cleanup { + destroy .c +} -result {right} +test button-1.168 {configuration option: "justify" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -justify bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.169 {configuration option: "justify" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -justify right + .r cget -justify +} -cleanup { + destroy .r +} -result {right} +test button-1.170 {configuration option: "justify" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -justify bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test button-1.171 {configuration option: "offrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offrelief flat + .c cget -offrelief +} -cleanup { + destroy .c +} -result {flat} +test button-1.172 {configuration option: "offrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offrelief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.173 {configuration option: "offrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -offrelief flat + .r cget -offrelief +} -cleanup { + destroy .r +} -result {flat} +test button-1.174 {configuration option: "offrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -offrelief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.175 {configuration option: "offvalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offvalue lousy + .c cget -offvalue +} -cleanup { + destroy .c +} -result {lousy} + +test button-1.176 {configuration option: "onvalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -onvalue fantastic + .c cget -onvalue +} -cleanup { + destroy .c +} -result {fantastic} + +test button-1.177 {configuration option: "overrelief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -overrelief "" + .b cget -overrelief +} -cleanup { + destroy .b +} -result {} +test button-1.178 {configuration option: "overrelief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -overrelief 1.5 +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.179 {configuration option: "overrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -overrelief "" + .c cget -overrelief +} -cleanup { + destroy .c +} -result {} +test button-1.180 {configuration option: "overrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -overrelief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.181 {configuration option: "overrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -overrelief "" + .r cget -overrelief +} -cleanup { + destroy .r +} -result {} +test button-1.182 {configuration option: "overrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -overrelief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.183 {configuration option: "padx" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -padx 12m + .l cget -padx +} -cleanup { + destroy .l +} -result {12m} +test button-1.184 {configuration option: "padx" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -padx 420x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.185 {configuration option: "padx" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -padx 12m + .b cget -padx +} -cleanup { + destroy .b +} -result {12m} +test button-1.186 {configuration option: "padx" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -padx 420x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.187 {configuration option: "padx" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -padx 12m + .c cget -padx +} -cleanup { + destroy .c +} -result {12m} +test button-1.188 {configuration option: "padx" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -padx 420x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.189 {configuration option: "padx" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -padx 12m + .r cget -padx +} -cleanup { + destroy .r +} -result {12m} +test button-1.190 {configuration option: "padx" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -padx 420x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "420x"} + +test button-1.191 {configuration option: "pady" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -pady 12m + .l cget -pady +} -cleanup { + destroy .l +} -result {12m} +test button-1.192 {configuration option: "pady" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -pady 420x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.193 {configuration option: "pady" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -pady 12m + .b cget -pady +} -cleanup { + destroy .b +} -result {12m} +test button-1.194 {configuration option: "pady" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -pady 420x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.195 {configuration option: "pady" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -pady 12m + .c cget -pady +} -cleanup { + destroy .c +} -result {12m} +test button-1.196 {configuration option: "pady" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -pady 420x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.197 {configuration option: "pady" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -pady 12m + .r cget -pady +} -cleanup { + destroy .r +} -result {12m} +test button-1.198 {configuration option: "pady" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -pady 420x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "420x"} + +test button-1.199 {configuration option: "repeatdelay" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatdelay 100 + .b cget -repeatdelay +} -cleanup { + destroy .b +} -result {100} +test button-1.200 {configuration option: "repeatdelay" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatdelay foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "foo"} + +test button-1.201 {configuration option: "repeatinterval" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatinterval 100 + .b cget -repeatinterval +} -cleanup { + destroy .b +} -result {100} +test button-1.202 {configuration option: "repeatinterval" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatinterval foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "foo"} + +test button-1.203 {configuration option: "relief" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -relief flat + .l cget -relief +} -cleanup { + destroy .l +} -result {flat} +test button-1.204 {configuration option: "relief" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -relief 1.5 +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.205 {configuration option: "relief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -relief flat + .b cget -relief +} -cleanup { + destroy .b +} -result {flat} +test button-1.206 {configuration option: "relief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -relief 1.5 +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.207 {configuration option: "relief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -relief flat + .c cget -relief +} -cleanup { + destroy .c +} -result {flat} +test button-1.208 {configuration option: "relief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -relief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.209 {configuration option: "relief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -relief flat + .r cget -relief +} -cleanup { + destroy .r +} -result {flat} +test button-1.210 {configuration option: "relief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -relief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.211 {configuration option: "selectcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectcolor #110022 + .c cget -selectcolor +} -cleanup { + destroy .c +} -result {#110022} +test button-1.212 {configuration option: "selectcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectcolor non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.213 {configuration option: "selectcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectcolor #110022 + .r cget -selectcolor +} -cleanup { + destroy .r +} -result {#110022} +test button-1.214 {configuration option: "selectcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectcolor non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.215 {configuration option: "selectimage" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectimage image1 + .c cget -selectimage +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.216 {configuration option: "selectimage" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectimage bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.217 {configuration option: "selectimage" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectimage image1 + .r cget -selectimage +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.218 {configuration option: "selectimage" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectimage bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.219 {configuration option: "state" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -state normal + .l cget -state +} -cleanup { + destroy .l +} -result {normal} +test button-1.220 {configuration option: "state" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -state bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.221 {configuration option: "state" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -state normal + .b cget -state +} -cleanup { + destroy .b +} -result {normal} +test button-1.222 {configuration option: "state" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -state bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.223 {configuration option: "state" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -state normal + .c cget -state +} -cleanup { + destroy .c +} -result {normal} +test button-1.224 {configuration option: "state" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -state bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.225 {configuration option: "state" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -state normal + .r cget -state +} -cleanup { + destroy .r +} -result {normal} +test button-1.226 {configuration option: "state" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -state bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} + +test button-1.227 {configuration option: "takefocus" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -takefocus "any string" + .l cget -takefocus +} -cleanup { + destroy .l +} -result {any string} +test button-1.228 {configuration option: "takefocus" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -takefocus "any string" + .b cget -takefocus +} -cleanup { + destroy .b +} -result {any string} +test button-1.229 {configuration option: "takefocus" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -takefocus "any string" + .c cget -takefocus +} -cleanup { + destroy .c +} -result {any string} +test button-1.230 {configuration option: "takefocus" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -takefocus "any string" + .r cget -takefocus +} -cleanup { + destroy .r +} -result {any string} + +test button-1.231 {configuration option: "text" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -text "Sample text" + .l cget -text +} -cleanup { + destroy .l +} -result {Sample text} +test button-1.232 {configuration option: "text" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -text "Sample text" + .b cget -text +} -cleanup { + destroy .b +} -result {Sample text} +test button-1.233 {configuration option: "text" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -text "Sample text" + .c cget -text +} -cleanup { + destroy .c +} -result {Sample text} +test button-1.234 {configuration option: "text" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -text "Sample text" + .r cget -text +} -cleanup { + destroy .r +} -result {Sample text} + +test button-1.235 {configuration option: "textvariable" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -textvariable i + .l cget -textvariable +} -cleanup { + destroy .l +} -result {i} +test button-1.236 {configuration option: "textvariable" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -textvariable i + .b cget -textvariable +} -cleanup { + destroy .b +} -result {i} +test button-1.237 {configuration option: "textvariable" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -textvariable i + .c cget -textvariable +} -cleanup { + destroy .c +} -result {i} +test button-1.238 {configuration option: "textvariable" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -textvariable i + .r cget -textvariable +} -cleanup { + destroy .r +} -result {i} + +test button-1.239 {configuration option: "tristateimage" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristateimage image1 + .c cget -tristateimage +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.240 {configuration option: "tristateimage" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristateimage bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.241 {configuration option: "tristateimage" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristateimage image1 + .r cget -tristateimage +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.242 {configuration option: "tristateimage" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristateimage bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.243 {configuration option: "underline" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -underline 5 + .l cget -underline +} -cleanup { + destroy .l +} -result {5} +test button-1.244 {configuration option: "underline" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -underline 3p +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.245 {configuration option: "underline" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -underline 5 + .b cget -underline +} -cleanup { + destroy .b +} -result {5} +test button-1.246 {configuration option: "underline" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -underline 3p +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.247 {configuration option: "underline" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -underline 5 + .c cget -underline +} -cleanup { + destroy .c +} -result {5} +test button-1.248 {configuration option: "underline" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -underline 3p +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.249 {configuration option: "underline" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -underline 5 + .r cget -underline +} -cleanup { + destroy .r +} -result {5} +test button-1.250 {configuration option: "underline" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -underline 3p +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "3p"} + +test button-1.251 {configuration option: "tristatevalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristatevalue unknowable + .c cget -tristatevalue +} -cleanup { + destroy .c +} -result {unknowable} +test button-1.252 {configuration option: "tristatevalue" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristatevalue unknowable + .r cget -tristatevalue +} -cleanup { + destroy .r +} -result {unknowable} + +test button-1.253 {configuration option: "value" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -value anyString + .r cget -value +} -cleanup { + destroy .r +} -result {anyString} + +test button-1.254 {configuration option: "width" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -width 402 + .l cget -width +} -cleanup { + destroy .l +} -result {402} +test button-1.255 {configuration option: "width" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -width 3p +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.256 {configuration option: "width" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -width 402 + .b cget -width +} -cleanup { + destroy .b +} -result {402} +test button-1.257 {configuration option: "width" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -width 3p +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.258 {configuration option: "width" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -width 402 + .c cget -width +} -cleanup { + destroy .c +} -result {402} +test button-1.259 {configuration option: "width" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -width 3p +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.260 {configuration option: "width" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -width 402 + .r cget -width +} -cleanup { + destroy .r +} -result {402} +test button-1.261 {configuration option: "width" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -width 3p +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "3p"} + +test button-1.262 {configuration option: "wraplength" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -wraplength 100 + .l cget -wraplength +} -cleanup { + destroy .l +} -result {100} +test button-1.263 {configuration option: "wraplength" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -wraplength 6x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.264 {configuration option: "wraplength" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -wraplength 100 + .b cget -wraplength +} -cleanup { + destroy .b +} -result {100} +test button-1.265 {configuration option: "wraplength" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -wraplength 6x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.266 {configuration option: "wraplength" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -wraplength 100 + .c cget -wraplength +} -cleanup { + destroy .c +} -result {100} +test button-1.267 {configuration option: "wraplength" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -wraplength 6x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.268 {configuration option: "wraplength" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -wraplength 100 + .r cget -wraplength +} -cleanup { + destroy .r +} -result {100} +test button-1.269 {configuration option: "wraplength" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -wraplength 6x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "6x"} + +test button-1.270 {configuration options} -body { +# Additional check to make sure that -selectcolor may be empty in +# checkbox widgets + checkbutton .c .c configure -selectcolor {} -} {} - -test button-3.1 {ButtonCreate - not enough cd ../unix -} { - list [catch {button} msg] $msg -} {1 {wrong # args: should be "button pathName ?options?"}} -test button-3.2 {ButtonCreate procedure - setting label class} { - catch {destroy .x} +} -cleanup { + destroy .c +} -result {} + +# ex-tests 3.* +test button-2.1 {ButtonCreate - not enough arguments} -body { + button +} -returnCodes {error} -result {wrong # args: should be "button pathName ?options?"} + +test button-2.2 {ButtonCreate procedure - setting label class} -body { label .x winfo class .x -} {Label} -test button-3.3 {ButtonCreate - setting button class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Label} +test button-2.3 {ButtonCreate - setting button class} -body { button .x winfo class .x -} {Button} -test button-3.4 {ButtonCreate - setting checkbutton class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Button} +test button-2.4 {ButtonCreate - setting checkbutton class} -body { checkbutton .x winfo class .x -} {Checkbutton} -test button-3.5 {ButtonCreate - setting radiobutton class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Checkbutton} +test button-2.5 {ButtonCreate - setting radiobutton class} -body { radiobutton .x winfo class .x -} {Radiobutton} -rename button gorp -test button-3.6 {ButtonCreate - setting class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Radiobutton} +test button-2.6 {ButtonCreate - setting class} -body { + rename button gorp gorp .x winfo class .x -} {Button} -rename gorp button -test button-3.7 {ButtonCreate - bad window name} { - list [catch {button foo} msg] $msg -} {1 {bad window path name "foo"}} -test button-3.8 {ButtonCreate procedure - error in default option value} { - catch {destroy .funny} +} -cleanup { + destroy .x + rename gorp button +} -result {Button} + +test button-2.7 {ButtonCreate - bad window name} -body { + button foo +} -cleanup { + destroy foo +} -returnCodes {error} -result {bad window path name "foo"} +######### test ex 3.8 +test button-2.8 {ButtonCreate procedure - error in default option value} -body { option add *funny.background bogus - list [catch {button .funny} msg] $msg $errorInfo -} {1 {unknown color name "bogus"} {unknown color name "bogus" + button .funny +} -cleanup { + option clear + destroy .funny +} -returnCodes {error} -result {unknown color name "bogus"} +test button-2.9 {ButtonCreate procedure - error in default option value} -body { + option add *funny.background bogus + catch {button .funny} + return $errorInfo +} -cleanup { + option clear + destroy .funny +} -result {unknown color name "bogus" (database entry for "-background" in widget ".funny") invoked from within -"button .funny"}} -test button-3.9 {ButtonCreate procedure - option error} { - catch {destroy .x} - list [catch {button .x -gorp foo} msg] $msg [winfo exists .x] -} {1 {unknown option "-gorp"} 0} -test button-3.10 {ButtonCreate procedure - return value} { - catch {destroy .abcd} +"button .funny"} + +test button-2.10 {ButtonCreate procedure - option error} -body { + button .x -gorp foo +} -cleanup { + destroy .x +} -returnCodes {error} -result {unknown option "-gorp"} +test button-2.11 {ButtonCreate procedure - option error} -body { + catch {button .x -gorp foo} + winfo exists .x +} -cleanup { + destroy .x +} -result 0 +######### ex 3.10 +test button-2.12 {ButtonCreate procedure - return value} -body { set x [button .abcd] - destroy .abc - set x -} {.abcd} - -test button-4.1 {ButtonWidgetCmd - too few arguments} { - list [catch {.b} msg] $msg -} {1 {wrong # args: should be ".b option ?arg arg ...?"}} -test button-4.2 {ButtonWidgetCmd - bad option name} { - list [catch {.b c} msg] $msg -} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}} -test button-4.3 {ButtonWidgetCmd - bad option name} { - list [catch {.b bogus} msg] $msg -} {1 {bad option "bogus": must be cget, configure, flash, or invoke}} -test button-4.4 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget a b} msg] $msg -} {1 {wrong # args: should be ".b cget option"}} -test button-4.5 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test button-4.6 {ButtonWidgetCmd procedure, "cget" option} { - .b configure -highlightthickness 3 - .b cget -highlightthickness -} {3} -test button-4.7 {ButtonWidgetCmd procedure, "cget" option} { - catch {.l cget -disabledforeground} -} {0} -test button-4.8 {ButtonWidgetCmd procedure, "cget" option} { - catch {.b cget -disabledforeground} -} {0} -test button-4.9 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget -variable} msg] $msg -} {1 {unknown option "-variable"}} -test button-4.10 {ButtonWidgetCmd procedure, "cget" option} { - catch {.c cget -variable} -} {0} -test button-4.11 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.c cget -value} msg] $msg -} {1 {unknown option "-value"}} -test button-4.12 {ButtonWidgetCmd procedure, "cget" option} { - catch {.r cget -value} -} {0} -test button-4.13 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.r cget -onvalue} msg] $msg -} {1 {unknown option "-onvalue"}} -test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { + return $x +} -cleanup { + destroy .abcd +} -result {.abcd} + +######### ex 4.* +test button-3.1 {ButtonWidgetCmd - too few arguments} -body { + button .b + .b +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b option ?arg arg ...?"} +test button-3.2 {ButtonWidgetCmd - bad option name} -body { + button .b + .b c +} -cleanup { + destroy .b +} -returnCodes {error} -result {ambiguous option "c": must be cget, configure, flash, or invoke} +test button-3.3 {ButtonWidgetCmd - bad option name} -body { + button .b + .b bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "bogus": must be cget, configure, flash, or invoke} +test button-3.4 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget a b +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b cget option"} +test button-3.5 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -gorp +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-gorp"} + +#ex 4.7 +test button-3.6 {ButtonWidgetCmd procedure, "cget" option} -body { + label .l + .l cget -disabledforeground +} -cleanup { + destroy .l +} -returnCodes {ok} -match {glob} -result {*} +test button-3.7 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -disabledforeground +} -cleanup { + destroy .b +} -returnCodes {ok} -match {glob} -result {*} +test button-3.8 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -variable +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-variable"} + +test button-3.9 {ButtonWidgetCmd procedure, "cget" option} -body { + checkbutton .c + .c cget -variable +} -cleanup { + destroy .c +} -returnCodes {ok} -match {glob} -result {*} +test button-3.10 {ButtonWidgetCmd procedure, "cget" option} -body { + checkbutton .c + .c cget -value +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown option "-value"} + +test button-3.11 {ButtonWidgetCmd procedure, "cget" option} -body { + radiobutton .r + .r cget -value +} -cleanup { + destroy .r +} -returnCodes {ok} -match {glob} -result {*} +test button-3.12 {ButtonWidgetCmd procedure, "cget" option} -body { + radiobutton .r + .r cget -onvalue +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown option "-onvalue"} + +# ex 4.6 +test button-3.13 {ButtonWidgetCmd procedure, "configure" option} -body { + button .b -highlightthickness 3 + lindex [.b configure -highlightthickness] 4 +} -cleanup { + destroy .b +} -result {3} +test button-3.14 {ButtonWidgetCmd procedure, "configure" option} -body { + checkbutton .c llength [.c configure] -} {41} -test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.b configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test button-4.16 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.b co -bg #ffffff -fg} msg] $msg -} {1 {value for "-fg" missing}} -test button-4.17 {ButtonWidgetCmd procedure, "configure" option} { +} -cleanup { + destroy .c +} -result {41} +test button-3.15 {ButtonWidgetCmd procedure, "configure" option} -body { + button .b + .b configure -gorp +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-gorp"} +test button-3.16 {ButtonWidgetCmd procedure, "configure" option} -setup { + button .b +} -body { + .b co -bg #ffffff -fg +} -cleanup { + destroy .b +} -returnCodes {error} -result {value for "-fg" missing} +test button-3.17 {ButtonWidgetCmd procedure, "configure" option} -setup { + button .b +} -body { .b configure -fg #123456 .b configure -bg #654321 lindex [.b configure -fg] 4 -} {#123456} -.c configure -variable value -onvalue 1 -offvalue 0 -.r configure -variable value2 -value red -test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.c deselect foo} msg] $msg -} {1 {wrong # args: should be ".c deselect"}} -test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.l deselect} msg] $msg -} {1 {bad option "deselect": must be cget or configure}} -test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.b deselect} msg] $msg -} {1 {bad option "deselect": must be cget, configure, flash, or invoke}} -test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} { - set value 1 +} -cleanup { + destroy .b +} -result {#123456} +test button-3.18 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c + .c deselect foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c deselect"} +test button-3.19 {ButtonWidgetCmd procedure, "deselect" option} -body { + label .l + .l deselect +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "deselect": must be cget or configure} +test button-3.20 {ButtonWidgetCmd procedure, "deselect" option} -body { + button .b + .b deselect +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "deselect": must be cget, configure, flash, or invoke} + +test button-3.21 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 .c d - set value -} {0} -test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} { - set value2 green + return $checkvar +} -cleanup { + destroy .c +} -result {0} +test button-3.22 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar green .r deselect - set value2 -} {green} -test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} { - set value2 red + return $radiovar +} -cleanup { + destroy .r +} -result {green} +test button-3.23 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red .r deselect - set value2 -} {} -test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} -body { - set value 1 - trace variable value w bogusTrace - set result [list [catch {.c deselect} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted + return $radiovar +} -cleanup { + destroy .r +} -result {} + +test button-3.24 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 + trace variable checkvar w bogusTrace + .c deselect +} -cleanup { + destroy .c + trace vdelete checkvar w bogusTrace +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.25 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 + trace variable checkvar w bogusTrace + catch {.c deselect} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c deselect"} 0} -test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} -body { - set value2 red - trace variable value2 w bogusTrace - set result [list [catch {.r deselect} msg] $msg $errorInfo $value2] - trace vdelete value2 w bogusTrace - set result -} -match glob -result {1 {can't set "value2": trace aborted} {*trace aborted +test button-3.26 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red + trace variable radiovar w bogusTrace + .r deselect +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match {glob} -returnCodes {error} -result {can't set "radiovar": trace aborted} +test button-3.27 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red + trace variable radiovar w bogusTrace + catch {.r deselect} + list $errorInfo $radiovar +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match glob -result {{*trace aborted while executing * ".r deselect"} {}} -test button-4.26 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.b flash foo} msg] $msg -} {1 {wrong # args: should be ".b flash"}} -test button-4.27 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.l flash} msg] $msg -} {1 {bad option "flash": must be cget or configure}} -test button-4.28 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.b flash} msg] $msg -} {0 {}} -test button-4.29 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.c flash} msg] $msg -} {0 {}} -test button-4.30 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.r f} msg] $msg -} {0 {}} -test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} { - list [catch {.b invoke foo} msg] $msg -} {1 {wrong # args: should be ".b invoke"}} -test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} { - list [catch {.l invoke} msg] $msg -} {1 {bad option "invoke": must be cget or configure}} -test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} { + +test button-3.28 {ButtonWidgetCmd procedure, "flash" option} -body { + button .b + .b flash foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b flash"} +test button-3.29 {ButtonWidgetCmd procedure, "flash" option} -body { + label .l + .l flash +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "flash": must be cget or configure} +test button-3.30 {ButtonWidgetCmd procedure, "flash" option} -body { + button .b + catch {.b flash} +} -cleanup { + destroy .b +} -returnCodes {ok} -match {glob} -result {*} +test button-3.31 {ButtonWidgetCmd procedure, "flash" option} -body { + checkbutton .c + catch {.c flash} +} -cleanup { + destroy .c +} -returnCodes {ok} -match {glob} -result {*} +test button-3.32 {ButtonWidgetCmd procedure, "flash" option} -body { + radiobutton .r + catch {.r f} +} -cleanup { + destroy .r +} -returnCodes {ok} -match {glob} -result {*} + +test button-3.33 {ButtonWidgetCmd procedure, "invoke" option} -body { + label .l + .l invoke +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "invoke": must be cget or configure} +test button-3.34 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b + .b invoke foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b invoke"} +test button-3.35 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b .b configure -command {set x invoked} set x "not invoked" .b invoke - set x -} {invoked} -test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} { + return $x +} -cleanup { + destroy .b +} -result {invoked} +test button-3.36 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b .b configure -command {set x invoked} -state disabled set x "not invoked" .b invoke - set x -} {not invoked} -test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} { - set value bogus - .c configure -command {set x invoked} -variable value -onvalue 1 \ - -offvalue 0 + return $x +} -cleanup { + destroy .b +} -result {not invoked} +test button-3.37 {ButtonWidgetCmd procedure, "invoke" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 \ + -command {set x invoked} + set checkvar bogus set x "not invoked" .c invoke - list $x $value -} {invoked 1} -test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} { - set value2 green - .r configure -command {set x invoked} -variable value2 -value red + list $x $checkvar +} -cleanup { + destroy .c +} -result {invoked 1} +test button-3.38 {ButtonWidgetCmd procedure, "invoke" option} -body { + radiobutton .r -command {set x invoked} -variable radiovar -value red + set radiovar green set x "not invoked" .r i - list $x $value2 -} {invoked red} -test button-4.37 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.l select} msg] $msg -} {1 {bad option "select": must be cget or configure}} -test button-4.38 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.b select} msg] $msg -} {1 {bad option "select": must be cget, configure, flash, or invoke}} -test button-4.39 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.c select foo} msg] $msg -} {1 {wrong # args: should be ".c select"}} -test button-4.40 {ButtonWidgetCmd procedure, "select" option} { - set value bogus - .c configure -command {} -variable value -onvalue lovely -offvalue 0 + list $x $radiovar +} -cleanup { + destroy .r +} -result {invoked red} + +test button-3.39 {ButtonWidgetCmd procedure, "select" option} -body { + label .l + .l select +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "select": must be cget or configure} +test button-3.40 {ButtonWidgetCmd procedure, "select" option} -body { + button .b + .b select +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "select": must be cget, configure, flash, or invoke} +test button-3.41 {ButtonWidgetCmd procedure, "select" option} -body { + checkbutton .c + .c select foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c select"} +test button-3.42 {ButtonWidgetCmd procedure, "select" option} -body { + checkbutton .c -variable checkvar -onvalue lovely -offvalue 0 + set checkvar bogus .c s - set value -} {lovely} -test button-4.41 {ButtonWidgetCmd procedure, "select" option} { - set value2 green - .r configure -command {} -variable value2 -value red + return $checkvar +} -cleanup { + destroy .c +} -result {lovely} +test button-3.43 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar green + .r select + return $radiovar +} -cleanup { + destroy .r +} -result {red} +test button-3.44 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar yellow + trace variable radiovar w bogusTrace .r select - set value2 -} {red} -test button-4.42 {ButtonWidgetCmd procedure, "select" option} -body { - set value2 yellow - trace variable value2 w bogusTrace - set result [list [catch {.r select} msg] $msg $errorInfo $value2] - trace vdelete value2 w bogusTrace - set result -} -match glob -result {1 {can't set "value2": trace aborted} {*trace aborted +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -returnCodes {error} -result {can't set "radiovar": trace aborted} +test button-3.45 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar yellow + trace variable radiovar w bogusTrace + catch {.r select} + list $errorInfo $radiovar +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match {glob} -result {{*trace aborted while executing * ".r select"} red} -test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.l toggle} msg] $msg -} {1 {bad option "toggle": must be cget or configure}} -test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.b toggle} msg] $msg -} {1 {bad option "toggle": must be cget, configure, flash, or invoke}} -test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.r toggle} msg] $msg -} {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}} -test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.c toggle foo} msg] $msg -} {1 {wrong # args: should be ".c toggle"}} -test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} { - set value bogus - .c configure -command {} -variable value -onvalue sunshine -offvalue rain + +# ex 4.43 +test button-3.46 {ButtonWidgetCmd procedure, "toggle" option} -body { + label .l + .l toggle +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "toggle": must be cget or configure} +test button-3.47 {ButtonWidgetCmd procedure, "toggle" option} -body { + button .b + .b toggle +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "toggle": must be cget, configure, flash, or invoke} +test button-3.48 {ButtonWidgetCmd procedure, "toggle" option} -body { + radiobutton .r + .r toggle +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select} +test button-3.49 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c + .c toggle foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c toggle"} +test button-3.50 {ButtonWidgetCmd procedure, "toggle" option} -body { + set checkvar bogus + checkbutton .c -variable checkvar -onvalue sunshine -offvalue rain .c toggle - set result $value + set result $checkvar .c toggle - lappend result $value + lappend result $checkvar .c toggle - lappend result $value -} {sunshine rain sunshine} -test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} -body { - .c configure -onvalue xyz -offvalue abc - set value xyz - trace variable value w bogusTrace - set result [list [catch {.c toggle} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted + lappend result $checkvar + return $result +} -cleanup { + destroy .c +} -result {sunshine rain sunshine} +test button-3.51 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar xyz + trace variable checkvar w bogusTrace + .c toggle +} -cleanup { + destroy .c + trace vdelete checkvar w bogusTrace +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.52 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar xyz + trace variable checkvar w bogusTrace + catch {.c toggle} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c toggle"} abc} -test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} -body { - .c configure -onvalue xyz -offvalue abc - set value abc - trace variable value w bogusTrace - set result [list [catch {.c toggle} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted +test button-3.53 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar abc + trace variable checkvar w bogusTrace + .c toggle +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.54 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar abc + trace variable checkvar w bogusTrace + catch {.c toggle} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c toggle"} xyz} -test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} { - catch {unset value}; set value(1) 1; - set result [list [catch {.c toggle} msg] $msg $errorInfo] - unset value; - set result -} {1 {can't set "value": variable is array} {can't set "value": variable is array +test button-3.55 {ButtonWidgetCmd procedure, "toggle" option} -setup { + unset -nocomplain checkvar +} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + unset checkvar + set checkvar(1) 1 + .c toggle +} -cleanup { + destroy .c +} -returnCodes {error} -result {can't set "checkvar": variable is array} +test button-3.56 {ButtonWidgetCmd procedure, "toggle" option} -setup { + unset -nocomplain checkvar +} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + unset checkvar + set checkvar(1) 1 + catch {.c toggle} + return $errorInfo +} -cleanup { + destroy .c +} -match {glob} -result {can't set "checkvar": variable is array while executing -".c toggle"}} +".c toggle"} -test button-5.1 {DestroyButton procedure} testImageType { +test button-4.1 {DestroyButton procedure} -constraints { + testImageType +} -setup { image create test image1 + unset -nocomplain x +} -body { button .b1 -image image1 button .b2 -fg #ff0000 -text "Button 2" button .b3 -state active -text "Button 3" @@ -437,402 +3211,722 @@ test button-5.1 {DestroyButton procedure} testImageType { checkbutton .b5 -variable x -text "Checkbutton 5" set x 1 pack .b1 .b2 .b3 .b4 .b5 - update - deleteWindows -} {} - -test button-6.1 {ConfigureButton - textvariable trace} { - catch {destroy .b1} - button .b1 -bd 4 -bg green - catch {.b1 configure -bd 7 -bg green -fg bogus} - list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \ - $msg [.b1 cget -bd] [.b1 cget -bg] -} {1 {unknown color name "bogus"} 4 green} -test button-6.2 {ConfigureButton - textvariable trace} { - catch {destroy .b1} + update + deleteWindows +} -cleanup { + destroy .b1 .b2 .b3 .b4 .b5 + image delete image1 +} -result {} + +test button-5.1 {ConfigureButton - textvariable trace} -body { + button .b -bd 4 -bg green + .b configure -bd 7 -bg red -fg bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "bogus"} +test button-5.2 {ConfigureButton - textvariable trace} -body { + button .b -bd 4 -bg green + catch {.b configure -bd 7 -bg red -fg bogus} + list [.b cget -bd] [.b cget -bg] +} -cleanup { + destroy .b +} -result {4 green} +test button-5.3 {ConfigureButton - textvariable trace} -body { + button .b -textvariable x set x From-x set y From-y - button .b1 -textvariable x - .b1 configure -textvariable y + .b configure -textvariable y set x New - lindex [.b1 configure -text] 4 -} {From-y} -test button-6.2a {ConfigureButton - variable traces} { - catch {destroy .b1} - catch {unset x} - checkbutton .b1 -variable x + lindex [.b configure -text] 4 +} -cleanup { + destroy .b +} -result {From-y} +test button-5.4 {ConfigureButton - variable trace} -body { ;# ex 6.2a + checkbutton .c -variable x set x 1 set y 1 - .b1 configure -textvariable y + .c configure -textvariable y set x 0 - .b1 toggle - set y -} {1} -test button-6.3 {ConfigureButton - image handling} testImageType { - catch {destroy .b1} - eval image delete [image names] + .c toggle + return $y +} -cleanup { + destroy .c +} -result {1} + +test button-5.5 {ConfigureButton - image handling} -constraints { + testImageType +} -setup { image create test image1 image create test image2 - button .b1 -image image1 +} -body { + button .b -image image1 image delete image1 - .b1 configure -image image2 + .b configure -image image2 image names -} {image2} -test button-6.5 {ConfigureButton - default value for variable} { - catch {destroy .b1} - checkbutton .b1 - .b1 cget -variable -} {b1} -test button-6.6 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} +} -cleanup { + destroy .b + image delete image1 image2 +} -result {image2} + +test button-5.6 {ConfigureButton - default value for variable} -body { + checkbutton .c + .c cget -variable +} -cleanup { + destroy .c +} -result {c} +test button-5.7 {ConfigureButton - setting selected state from variable} -body { set x 0 set y Shiny - checkbutton .b1 -variable x - .b1 configure -variable y -onvalue Shiny - .b1 toggle - set y -} 0 -test button-6.7 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} - catch {unset x} - checkbutton .b1 -variable x -offvalue Bogus - set x -} Bogus -test button-6.8 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} - catch {unset x} - radiobutton .b1 -variable x - set x -} {} -test button-6.9 {ConfigureButton - error in setting variable} { - catch {destroy .b1} - catch {unset x} + checkbutton .c -variable x + .c configure -variable y -onvalue Shiny + .c toggle + return $y +} -cleanup { + destroy .c +} -result {0} +test button-5.8 {ConfigureButton - setting selected state from variable} -setup { + unset -nocomplain x +} -body { + checkbutton .c -variable x -offvalue Bogus + return $x +} -cleanup { + destroy .c +} -result {Bogus} + +test button-5.9 {ConfigureButton - setting selected state from variable} -setup { + unset -nocomplain x +} -body { + radiobutton .r -variable x + return $x +} -cleanup { + destroy .r +} -result {} + +test button-5.10 {ConfigureButton - error in setting variable} -setup { + unset -nocomplain x +} -body { trace variable x w bogusTrace - set result [list [catch {radiobutton .b1 -variable x} msg] $msg] + radiobutton .r -variable x +} -cleanup { + destroy .r trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted}} -test button-6.10 {ConfigureButton - bad image name} { - catch {destroy .b1} - list [catch {button .b1 -image bogus} msg] $msg -} {1 {image "bogus" doesn't exist}} -test button-6.11 {ConfigureButton - setting variable from current text value} { - catch {destroy .b1} - catch {unset x} - button .b1 -textvariable x -text "Button 1" - set x -} {Button 1} -test button-6.12 {ConfigureButton - using current value of variable} { - catch {destroy .b1} +} -returnCodes {error} -result {can't set "x": trace aborted} + +test button-5.11 {ConfigureButton - bad image name} -body { + button .b -image bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-5.12 {ConfigureButton - setting variable from current text value} -setup { + unset -nocomplain x +} -body { + button .b -textvariable x -text "Button 1" + return $x +} -cleanup { + destroy .b +} -result {Button 1} + +test button-5.13 {ConfigureButton - using current value of variable} -body { set x Override - button .b1 -textvariable x -text "Button 1" - set x -} {Override} -test button-6.13 {ConfigureButton - variable handling} { - catch {destroy .b1} - catch {unset x} + button .b -textvariable x -text "Button 1" + return $x +} -cleanup { + destroy .b +} -result {Override} + +test button-5.14 {ConfigureButton - variable handling} -setup { + unset -nocomplain x +} -body { + trace variable x w bogusTrace + radiobutton .r -text foo -textvariable x +} -cleanup { + trace vdelete x w bogusTrace + destroy .r +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-5.15 {ConfigureButton - variable handling} -setup { + unset -nocomplain x +} -body { trace variable x w bogusTrace - set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \ - $msg $x] + catch {radiobutton .r -text foo -textvariable x} + return $x +} -cleanup { trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} foo} -test button-6.14 {ConfigureButton - -width option} { - catch {destroy .b1} - button .b1 -text "Button 1" - list [catch {.b1 configure -width 1i} msg] $msg $errorInfo -} {1 {expected integer but got "1i"} {expected integer but got "1i" + destroy .r +} -result {foo} + +#ex 6.14 +test button-5.16 {ConfigureButton - -width option} -body { + button .b -text "Button 1" + .b configure -width 1i +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "1i"} +test button-5.17 {ConfigureButton - -width option} -body { + button .b -text "Button 1" + catch {.b configure -width 1i} + return $errorInfo +} -cleanup { + destroy .b +} -result {expected integer but got "1i" (processing -width option) invoked from within -".b1 configure -width 1i"}} -test button-6.15 {ConfigureButton - -height option} { - catch {destroy .b1} - button .b1 -text "Button 1" - list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo -} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c" +".b configure -width 1i"} +test button-5.18 {ConfigureButton - -height option} -body { + button .b -text "Button 1" + .b configure -height 0.5c +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "0.5c"} +test button-5.19 {ConfigureButton - -height option} -body { + button .b -text "Button 1" + catch {.b configure -height 0.5c} + return $errorInfo +} -cleanup { + destroy .b +} -result {expected integer but got "0.5c" (processing -height option) invoked from within -".b1 configure -height 0.5c"}} -test button-6.16 {ConfigureButton - -width option} { - catch {destroy .b1} - button .b1 -bitmap questhead - list [catch {.b1 configure -width abc} msg] $msg $errorInfo -} {1 {bad screen distance "abc"} {bad screen distance "abc" +".b configure -height 0.5c"} +#ex 6.16 +test button-5.20 {ConfigureButton - -width option} -body { + button .b -bitmap questhead + .b configure -width abc +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "abc"} +test button-5.21 {ConfigureButton - -width option} -body { + button .b -bitmap questhead + catch {.b configure -width abc} + return $errorInfo +} -cleanup { + destroy .b +} -result {bad screen distance "abc" (processing -width option) invoked from within -".b1 configure -width abc"}} -test button-6.17 {ConfigureButton - -height option} testImageType { - catch {destroy .b1} - eval image delete [image names] +".b configure -width abc"} +test button-5.22 {ConfigureButton - -height option} -constraints { + testImageType +} -setup { image create test image1 - button .b1 -image image1 - list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo -} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x" +} -body { + button .b -image image1 + .b configure -height 0.5x +} -cleanup { + destroy .b + image delete image1 +} -returnCodes {error} -result {bad screen distance "0.5x"} +test button-5.23 {ConfigureButton - -height option} -constraints { + testImageType +} -setup { + image create test image1 +} -body { +#ztestImageType + button .b -image image1 + catch {.b configure -height 0.5x} + return $errorInfo +} -cleanup { + destroy .b + image delete image1 +} -result {bad screen distance "0.5x" (processing -height option) invoked from within -".b1 configure -height 0.5x"}} -test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} { - catch {destroy .b1} - button .b1 -text "Sample text" -width 10 -height 2 - pack .b1 - set result "[winfo reqwidth .b1] [winfo reqheight .b1]" - .b1 configure -bitmap questhead - lappend result [winfo reqwidth .b1] [winfo reqheight .b1] -} {102 46 20 12} -test button-6.19 {ConfigureButton - computing geometry} { - catch {destroy .b1} - button .b1 -text "Button 1" - set old [winfo reqwidth .b1] - .b1 configure -text "Much longer text" - set new [winfo reqwidth .b1] - expr $old == $new -} {0} - -test button-7.1 {ButtonEventProc procedure} { - catch {destroy .b1} - button .b1 -text "Test Button" -command { - destroy .b1 - set x [list [winfo exists .b1] [info commands .b1]] - } - .b1 invoke - set x -} {0 {}} -test button-7.2 {ButtonEventProc procedure} { - deleteWindows +".b configure -height 0.5x"} +#ex 6.18 +test button-5.24 {ConfigureButton - computing geometry} -constraints { + fonts +} -body { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + .b configure -text "Sample text" -width 10 -height 2 + pack .b + set result "[winfo reqwidth .b] [winfo reqheight .b]" + .b configure -bitmap questhead + lappend result [winfo reqwidth .b] [winfo reqheight .b] +} -cleanup { + destroy .b +} -result {104 46 20 12} + +test button-5.25 {ConfigureButton - computing geometry} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} +} -body { + .b configure -text "Button 1" + set old [winfo reqwidth .b] + .b configure -text "Much longer text" + set new [winfo reqwidth .b] + expr {$old == $new} +} -cleanup { + destroy .b +} -result {0} + +test button-6.1 {ButtonEventProc procedure} -body { + button .b -text "Test Button" -command { + destroy .b + set x [list [winfo exists .b] [info commands .b]] +} + .b invoke + return $x +} -cleanup { + destroy .b +} -result {0 {}} + +test button-6.2 {ButtonEventProc procedure} -setup { + set x {} +} -body { button .b1 -bg #543210 rename .b1 .b2 - set x {} lappend x [winfo children .] lappend x [.b2 cget -bg] destroy .b1 lappend x [info command .b*] [winfo children .] -} {.b1 #543210 {} {}} +} -cleanup { + destroy .b1 +} -result {.b1 #543210 {} {}} -test button-8.1 {ButtonCmdDeletedProc procedure} { - deleteWindows - button .b1 - rename .b1 {} +test button-7.1 {ButtonCmdDeletedProc procedure} -body { + button .b + rename .b {} list [info command .b*] [winfo children .] -} {{} {}} +} -cleanup { + destroy .b +} -result {{} {}} -test button-9.1 {TkInvokeButton procedure} { - catch {destroy .b1} +test button-8.1 {TkInvokeButton procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set result $x - .b1 invoke + .c invoke lappend result $x - .b1 invoke + .c invoke lappend result $x -} {0 1 0} -test button-9.2 {TkInvokeButton procedure} { - catch {destroy .b1} +} -cleanup { + destroy .c +} -result {0 1 0} + +test button-8.2 {TkInvokeButton procedure} -setup { + set x 0 +} -body { + checkbutton .c -variable x + trace variable x w bogusTrace + .c invoke +} -cleanup { + destroy .c + trace vdelete x w bogusTrace +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.3 {TkInvokeButton procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x + trace variable x w bogusTrace + catch {.c invoke} + return $x +} -cleanup { + destroy .c + trace vdelete x w bogusTrace +} -result {1} +test button-8.4 {TkInvokeButton procedure} -setup { + set x 1 +} -body { + checkbutton .c -variable x trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $x] + .c invoke +} -cleanup { + destroy .c trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} 1} -test button-9.3 {TkInvokeButton procedure} { - catch {destroy .b1} +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.5 {TkInvokeButton procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $x] + catch {.c invoke} + return $x +} -cleanup { + destroy .c trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} 0} -test button-9.4 {TkInvokeButton procedure} { - catch {destroy .b1} +} -result {0} + +test button-8.6 {TkInvokeButton procedure} -setup { set x 0 - radiobutton .b1 -variable x -value red +} -body { + radiobutton .r -variable x -value red set result $x - .b1 invoke + .r invoke lappend result $x - .b1 invoke + .r invoke lappend result $x -} {0 red red} -test button-9.5 {TkInvokeButton procedure} -body { - catch {destroy .b1} - radiobutton .b1 -variable x -value red +} -cleanup { + destroy .r +} -result {0 red red} + +test button-8.7 {TkInvokeButton procedure} -body { + radiobutton .r -variable x -value red set x green trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $errorInfo $x] + .r invoke +} -cleanup { + destroy .r trace vdelete x w bogusTrace - set result -} -match glob -result {1 {can't set "x": trace aborted} {*trace aborted +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.8 {TkInvokeButton procedure} -body { + radiobutton .r -variable x -value red + set x green + trace variable x w bogusTrace + catch {.r invoke} + list $errorInfo $x +} -cleanup { + destroy .r + trace vdelete x w bogusTrace +} -match {glob} -result {{*trace aborted while executing * -".b1 invoke"} red} -test button-9.6 {TkInvokeButton procedure} { - deleteWindows +".r invoke"} red} + +#ex 9.6 +test button-8.9 {TkInvokeButton procedure} -setup { set result untouched - button .b1 -command {set result invoked} - list [catch {.b1 invoke} msg] $msg $result -} {0 invoked invoked} -test button-9.7 {TkInvokeButton procedure} { - deleteWindows +} -body { + button .b -command {set result invoked} + set msg [.b invoke] + list $msg $result +} -cleanup { + destroy .b +} -result {invoked invoked} +test button-8.10 {TkInvokeButton procedure} -setup { set result untouched set x 0 - checkbutton .b1 -variable x -command {set result "invoked $x"} - list [catch {.b1 invoke} msg] $msg $result -} {0 {invoked 1} {invoked 1}} -test button-9.8 {TkInvokeButton procedure} { - deleteWindows +} -body { + checkbutton .c -variable x -command {set result "invoked $x"} + set msg [.c invoke] + list $msg $result +} -cleanup { + destroy .c +} -result {{invoked 1} {invoked 1}} +test button-8.11 {TkInvokeButton procedure} -setup { set result untouched set x 0 - radiobutton .b1 -variable x -value red -command {set result "invoked $x"} - list [catch {.b1 invoke} msg] $msg $result -} {0 {invoked red} {invoked red}} +} -body { + radiobutton .r -variable x -value red -command {set result "invoked $x"} + set msg [.r invoke] + list $msg $result +} -cleanup { + destroy .r +} -result {{invoked red} {invoked red}} -test button-10.1 {ButtonVarProc procedure} { - deleteWindows +test button-9.1 {ButtonVarProc procedure} -body { set x 1 - checkbutton .b1 -variable x + checkbutton .c -variable x unset x set result [info exists x] - .b1 toggle + .c toggle lappend result $x set x 0 - .b1 toggle + .c toggle lappend result $x -} {0 1 1} -test button-10.2 {ButtonVarProc procedure} { - deleteWindows +} -cleanup { + destroy .c +} -result {0 1 1} +test button-9.2 {ButtonVarProc procedure} -body { set x 0 - checkbutton .b1 -variable x + checkbutton .c -variable x set x 44 - .b1 toggle - set x -} {1} -test button-10.3 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.3 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 44 - .b1 toggle - set x -} {1} -test button-10.4 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.4 {ButtonVarProc procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 1 - .b1 toggle - set x -} {0} -test button-10.5 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {0} +test button-9.5 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 1 - .b1 toggle - set x -} {0} -test button-10.6 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {0} +test button-9.6 {ButtonVarProc procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 0 - .b1 toggle - set x -} {1} -test button-10.7 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.7 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 0 - .b1 toggle - set x -} {1} -test button-10.8 {ButtonVarProc procedure, can't read variable} { - # This test does nothing but produce a core dump if there's a prbblem. - deleteWindows - catch {unset a} - checkbutton .b1 -variable a + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.8 {ButtonVarProc procedure, can't read variable} -setup { +# This test does nothing but produce a core dump if there's a prbblem. + unset -nocomplain a +} -body { + checkbutton .c -variable a unset a set a(32) 0 unset a -} {} +} -cleanup { + destroy .c +} -result {} -test button-11.1 {ButtonTextVarProc procedure} { - deleteWindows +test button-10.1 {ButtonTextVarProc procedure} -body { set x Label - button .b1 -textvariable x + button .b -textvariable x unset x - set result [list $x [lindex [.b1 configure -text] 4]] + set result [list $x [.b cget -text]] set x New - lappend result [lindex [.b1 configure -text] 4] -} {Label Label New} -test button-11.2 {ButtonTextVarProc procedure} { - deleteWindows - # Windows buttons have a default min width, so we have to - # set this to be longer to force the wider button. + lappend result [.b cget -text] +} -cleanup { + destroy .b +} -result {Label Label New} +test button-10.2 {ButtonTextVarProc procedure} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} +} -body { +# Windows buttons have a default min width, so we have to +# set this to be longer to force the wider button. set x ExtraLongLabel - button .b1 -textvariable x - set old [winfo reqwidth .b1] + .b configure -textvariable x + set old [winfo reqwidth .b] set x New - set new [winfo reqwidth .b1] - list [lindex [.b1 configure -text] 4] [expr $old == $new] -} {New 0} + set new [winfo reqwidth .b] + expr {$old == $new} +} -cleanup { + destroy .b +} -result {0} -test button-12.1 {ButtonImageProc procedure} testImageType { - deleteWindows - eval image delete [image names] +test button-11.1 {ButtonImageProc procedure} -constraints { + testImageType +} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} image create test image1 - label .b1 -image image1 -padx 0 -pady 0 -bd 0 - pack .b1 - set result "[winfo reqwidth .b1] [winfo reqheight .b1]" +} -body { + .l configure -image image1 -padx 0 -pady 0 -bd 0 + pack .l + set result "[winfo reqwidth .l] [winfo reqheight .l]" image1 changed 0 0 0 0 80 100 - lappend result [winfo reqwidth .b1] [winfo reqheight .b1] -} {30 15 80 100} - -deleteWindows -set l [interp hidden] + lappend result [winfo reqwidth .l] [winfo reqheight .l] +} -cleanup { + destroy .l + image delete image1 +} -result {30 15 80 100} -test button-13.1 {button widget vs hidden commands} { - catch {destroy .b} +test button-12.1 {button widget vs hidden commands} -body { button .b -text hello + set l [interp hidden] interp hide {} .b destroy .b - list [winfo children .] [interp hidden] -} [list {} $l] - -deleteWindows - -test button-14.1 {size behaviouor} { - set res {} - foreach class {label button radiobutton checkbutton} { - eval destroy [winfo children .] - - $class .a -text Hej - $class .b -text Hej -width 10 -height 1 - $class .c -text "" -width 10 -height 1 - - for {set t 0} {$t < 2} {incr t} { - set res2 {} - # With -width, width should not be affected by text change - lappend res2 [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] - # With -height, height should not be affected by text change - lappend res2 [expr {[winfo reqheight .b] == [winfo reqheight .c]}] - # A one line text should be as high as -height 1 - lappend res2 [expr {[winfo reqheight .a] == [winfo reqheight .b]}] - lappend res $res2 - - # Do the second round with another font - .a configure -font "Arial 20" - .b configure -font "Arial 20" - .c configure -font "Arial 20" - } - } - set res -} {{1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1}} - -deleteWindows - -option clear - -# cleanup + + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -cleanup { + destroy .b +} -result {1} + +test button-13.1 {size behaviouor: label} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Helvetica -12 bold} + set result {} +} -body { + label .a -text Hej + label .b -text Hej -width 10 -height 1 + label .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.2 {size behaviouor: label} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Arial 20} + set result {} +} -body { + label .a -text Hej + label .b -text Hej -width 10 -height 1 + label .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.3 {size behaviouor: button} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Helvetica -12 bold} + set result {} +} -body { + label .a -text Hej + label .b -text Hej -width 10 -height 1 + label .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} +test button-13.4 {size behaviouor: button} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Arial 20} + set result {} +} -body { + button .a -text Hej + button .b -text Hej -width 10 -height 1 + button .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.5 {size behaviouor: radiobutton} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Helvetica -12 bold} + set result {} +} -body { + radiobutton .a -text Hej + radiobutton .b -text Hej -width 10 -height 1 + radiobutton .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.6 {size behaviouor: radiobutton} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Arial 20} + set result {} +} -body { + radiobutton .a -text Hej + radiobutton .b -text Hej -width 10 -height 1 + radiobutton .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.7 {size behaviouor: checkbutton} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Helvetica -12 bold} + set result {} +} -body { + checkbutton .a -text Hej + checkbutton .b -text Hej -width 10 -height 1 + checkbutton .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + +test button-13.8 {size behaviouor: checkbutton} -setup { + option add *Button.borderwidth 2 + option add *Button.highlightThickness 2 + option add *Button.font {Arial 20} + set result {} +} -body { + checkbutton .a -text Hej + checkbutton .b -text Hej -width 10 -height 1 + checkbutton .c -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c + option clear +} -result {1 1 1} + + cleanupTests return + + + + + + + + + diff --git a/tests/entry.test b/tests/entry.test index dadf623..83d16a0 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -6,223 +6,882 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: entry.test,v 1.22 2007/12/13 15:27:54 dgp Exp $ +# RCS: @(#) $Id: entry.test,v 1.23 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 +# For xscrollcommand proc scroll args { - global scrollInfo - set scrollInfo $args + global scrollInfo + set scrollInfo $args +} +# For trace variable +proc override args { + global x + set x 12345 } -# Create additional widget that's used to hold the selection at times. - -entry .sel -.sel insert end "This is some sample text" - -# Font names - -set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 -set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 - -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. - -option add *Entry.borderWidth 2 -option add *Entry.highlightThickness 2 -option add *Entry.font {Helvetica -12} - -entry .e -bd 2 -relief sunken -pack .e -update - -set i 1 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledbackground green green non-existent - {unknown color name "non-existent"}} - {-disabledforeground blue blue non-existent - {unknown color name "non-existent"}} - {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} - {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} - {-highlightthickness -2 0 {} {}} - {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} - {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} - {-insertontime 100 100 3.2 {expected integer but got "3.2"}} - {-invalidcommand "any string" "any string" {} {}} - {-invcmd "any string" "any string" {} {}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-readonlybackground green green non-existent - {unknown color name "non-existent"}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} - {-show * * {} {}} - {-state n normal bogus - {bad state "bogus": must be disabled, normal, or readonly}} - {-takefocus "any string" "any string" {} {}} - {-textvariable i i {} {}} - {-width 402 402 3p {expected integer but got "3p"}} - {-xscrollcommand {Some command} {Some command} {} {}} -} { - lassign $test name goodValue goodResult badValue badResult - test entry-1.$i {configuration options} { - .e configure $name $goodValue - list [lindex [.e configure $name] 4] [.e cget $name] - } [list $goodResult $goodResult] - incr i - if {$badValue ne ""} { - test entry-1.$i {configuration options} -body { - .e configure $name $badValue - } -returnCodes error -result $badResult - } - .e configure $name [lindex [.e configure $name] 3] - incr i +# Procedures used in widget VALIDATION tests +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 1 +} +proc doval2 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + set ::e mydata + return 1 +} +proc doval3 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 0 } -test entry-2.1 {Tk_EntryCmd procedure} { - list [catch {entry} msg] $msg -} {1 {wrong # args: should be "entry pathName ?options?"}} -test entry-2.2 {Tk_EntryCmd procedure} { - list [catch {entry gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test entry-2.3 {Tk_EntryCmd procedure} { - catch {destroy .e} +set cy [font metrics {Courier -12} -linespace] + + +test entry-1.1 {configuration option: "background" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -background #ff0000 + .e cget -background +} -cleanup { + destroy .e +} -result {#ff0000} +test entry-1.2 {configuration option: "background" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -background non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.3 {configuration option: "bd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bd 4 + .e cget -bd +} -cleanup { + destroy .e +} -result {4} +test entry-1.4 {configuration option: "bd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bd badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.5 {configuration option: "bg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bg #ff0000 + .e cget -bg +} -cleanup { + destroy .e +} -result {#ff0000} +test entry-1.6 {configuration option: "bg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.7 {configuration option: "borderwidth" for entry} -setup { + entry .e -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -borderwidth 1.3 + .e cget -borderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.8 {configuration option: "borderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -borderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.9 {configuration option: "cursor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -cursor arrow + .e cget -cursor +} -cleanup { + destroy .e +} -result {arrow} +test entry-1.10 {configuration option: "cursor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -cursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledbackground green + .e cget -disabledbackground +} -cleanup { + destroy .e +} -result {green} +test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledforeground blue + .e cget -disabledforeground +} -cleanup { + destroy .e +} -result {blue} +test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledforeground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.15 {configuration option: "exportselection" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -exportselection yes + .e cget -exportselection +} -cleanup { + destroy .e +} -result {1} +test entry-1.16 {configuration option: "exportselection" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -exportselection xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test entry-1.17 {configuration option: "fg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -fg #110022 + .e cget -fg +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.18 {configuration option: "fg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -fg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.19 {configuration option: "font" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e configure -font {Helvetica -12} + .e cget -font +} -cleanup { + destroy .e +} -result {Helvetica -12} +test entry-1.20 {configuration option: "font" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e configure -font {} +} -cleanup { + destroy .e +} -returnCodes {error} -result {font "" doesn't exist} + +test entry-1.21 {configuration option: "foreground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -foreground #110022 + .e cget -foreground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.22 {configuration option: "foreground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -foreground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightbackground #110022 + .e cget -highlightbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightcolor #110022 + .e cget -highlightcolor +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightcolor non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness 6 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {6} +test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness -2 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {0} +test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.30 {configuration option: "insertbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertbackground #110022 + .e cget -insertbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.31 {configuration option: "insertbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertborderwidth 1.3 + .e cget -insertborderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertborderwidth 2.6x +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "2.6x"} + +test entry-1.34 {configuration option: "insertofftime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertofftime 100 + .e cget -insertofftime +} -cleanup { + destroy .e +} -result {100} +test entry-1.35 {configuration option: "insertofftime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertofftime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test entry-1.36 {configuration option: "insertontime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertontime 100 + .e cget -insertontime +} -cleanup { + destroy .e +} -result {100} +test entry-1.37 {configuration option: "insertontime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertontime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -invalidcommand "any string" + .e cget -invalidcommand +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.39 {configuration option: "invcmd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -invcmd "any string" + .e cget -invcmd +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.40 {configuration option: "justify" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -justify right + .e cget -justify +} -cleanup { + destroy .e +} -result {right} +test entry-1.41 {configuration option: "justify" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -justify bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -readonlybackground green + .e cget -readonlybackground +} -cleanup { + destroy .e +} -result {green} +test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -readonlybackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.44 {configuration option: "relief" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -relief flat + .e cget -relief +} -cleanup { + destroy .e +} -result {flat} + +test entry-1.45 {configuration option: "selectbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectbackground #110022 + .e cget -selectbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.46 {configuration option: "selectbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectborderwidth 1.3 + .e cget -selectborderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectborderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.49 {configuration option: "selectforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectforeground #110022 + .e cget -selectforeground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.50 {configuration option: "selectforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectforeground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.51 {configuration option: "show" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -show * + .e cget -show +} -cleanup { + destroy .e +} -result {*} + +test entry-1.52 {configuration option: "state" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -state n + .e cget -state +} -cleanup { + destroy .e +} -result {normal} +test entry-1.53 {configuration option: "state" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -state bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad state "bogus": must be disabled, normal, or readonly} + +test entry-1.54 {configuration option: "takefocus" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -takefocus "any string" + .e cget -takefocus +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.55 {configuration option: "textvariable" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -textvariable i + .e cget -textvariable +} -cleanup { + destroy .e +} -result {i} + +test entry-1.56 {configuration option: "width" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -width 402 + .e cget -width +} -cleanup { + destroy .e +} -result {402} +test entry-1.57 {configuration option: "width" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -width 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -xscrollcommand {Some command} + .e cget -xscrollcommand +} -cleanup { + destroy .e +} -result {Some command} + + + +test entry-2.1 {Tk_EntryCmd procedure} -body { + entry +} -returnCodes error -result {wrong # args: should be "entry pathName ?options?"} +test entry-2.2 {Tk_EntryCmd procedure} -body { + entry gorp +} -returnCodes error -result {bad window path name "gorp"} +test entry-2.3 {Tk_EntryCmd procedure} -body { entry .e + pack .e + update list [winfo exists .e] [winfo class .e] [info commands .e] -} {1 Entry .e} -test entry-2.4 {Tk_EntryCmd procedure} { - catch {destroy .e} - list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \ - [info commands .e] -} {1 {unknown option "-gorp"} 0 {}} -test entry-2.5 {Tk_EntryCmd procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {1 Entry .e} +test entry-2.4 {Tk_EntryCmd procedure} -body { + entry .e -gorp foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test entry-2.5 {Tk_EntryCmd procedure} -body { + catch {entry .e -gorp foo} + list [winfo exists .e] [info commands .e] +} -cleanup { + destroy .e +} -result {0 {}} +test entry-2.6 {Tk_EntryCmd procedure} -body { entry .e -} {.e} - -catch {destroy .e} -entry .e -font $fixed -pack .e -update - -set cx [font measure $fixed a] -set cy [font metrics $fixed -linespace] -set ux [font measure $fixed \u4e4e] - -test entry-3.1 {EntryWidgetCmd procedure} { - list [catch {.e} msg] $msg -} {1 {wrong # args: should be ".e option ?arg arg ...?"}} -test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox a b} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox bogus} msg] $msg -} {1 {bad entry index "bogus"}} -test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end - .e bbox 0 -} [list 5 5 0 $cy] -test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no utf chars +} -cleanup { + destroy .e +} -result {.e} - .e delete 0 end + +test entry-3.1 {EntryWidgetCmd procedure} -setup { + entry .e + pack .e + update +} -body { + .e +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e option ?arg arg ...?"} +test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e + pack .e + update +} -body { + .e bbox bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bogus"} +test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox 0 +} -cleanup { + destroy .e +} -result [list 5 5 0 $cy] + +# Previously the result was count using previousli counted font measurements +# and metrics. It was changed to less verbose solution - the result is the one +# that passes fonts constraint (this concerns tests 3.6, 3.7, 3.8, 3.10) +test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no utf chars .e insert 0 "abc" list [.e bbox 3] [.e bbox end] -} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] -test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf at end - .e delete 0 end +} -cleanup { + destroy .e +} -result {{19 5 7 13} {19 5 7 13}} +test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf at end .e insert 0 "ab\u4e4e" .e bbox end -} "[expr 5+2*$cx] 5 $ux $cy" -test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf before index - .e delete 0 end +} -cleanup { + destroy .e +} -result {19 5 12 13} +test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf before index .e insert 0 "ab\u4e4ec" .e bbox 3 -} "[expr 5+2*$cx+$ux] 5 $cx $cy" -test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no chars - .e delete 0 end +} -cleanup { + destroy .e +} -result {31 5 7 13} +test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no chars .e bbox end -} "5 5 0 $cy" -test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result "5 5 0 $cy" +test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { .e insert 0 "abcdefghij\u4e4eklmnop" list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] -} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] -test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget a b} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} { +} -cleanup { + destroy .e +} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}} +test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget -gorp +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { .e configure -bd 4 .e cget -bd -} {4} -test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {4} +test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e + pack .e + update +} -body { llength [.e configure] -} {36} -test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} { - list [catch {.e configure -foo} msg] $msg -} {1 {unknown option "-foo"}} -test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {36} +test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e +} -body { + .e configure -foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-foo"} +test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e +} -body { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 -} {4} -test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete a b c} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete 0 bar} msg] $msg -} {1 {bad entry index "bar"}} -test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete 0 bar +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bar"} +test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 2 4 .e get -} {014567890} -test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {014567890} +test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { .e insert end "01234567890" .e delete 6 .e get -} {0123457890} -test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { - # UTF +} -cleanup { + destroy .e +} -result {0123457890} +test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update set x {} - .e delete 0 end +} -body { +# UTF .e insert end "01234\u4e4e67890" .e delete 6 lappend x [.e get] @@ -234,311 +893,659 @@ test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { .e insert end "0123456\u4e4e890" .e delete 6 lappend x [.e get] -} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] -test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] +test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 6 5 .e get -} {01234567890} -test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.27 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state readonly .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} { - list [catch {.e get foo} msg] $msg -} {1 {wrong # args: should be ".e get"}} -test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor} msg] $msg -} {1 {wrong # args: should be ".e icursor pos"}} -test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.28 {EntryWidgetCmd procedure, "get" widget command} -setup { + entry .e +} -body { + .e get foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e get"} +test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { + .e icursor +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e icursor pos"} +test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { + .e icursor foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.31 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { .e insert end "01234567890" .e icursor 4 .e index insert -} {4} -test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e in} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} -test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index} msg] $msg -} {1 {wrong # args: should be ".e index string"}} -test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index 0} msg] $msg -} {0 0} -test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} { - # UTF - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e in +} -cleanup { + destroy .e +} -returnCodes error -result {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview} +test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e index +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e index string"} +test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e index foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e + pack .e + update +} -body { + .e index 0 +} -cleanup { + destroy .e +} -returnCodes {ok} -match glob -result {*} +test entry-3.36 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e + pack .e + update +} -body { +# UTF .e insert 0 abc\u4e4e\u0153def list [.e index 3] [.e index 4] [.e index end] -} {3 4 8} -test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert foo Text} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 8} +test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert foo Text +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e insert 3 xxx .e get -} {012xxx34567890} -test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {012xxx34567890} +test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.42 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state readonly .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a b c} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan foobar 20} msg] $msg -} {1 {bad scan option "foobar": must be mark or dragto}} -test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan mark 20.1} msg] $msg -} {1 {expected integer but got "20.1"}} -# This test is non-portable because character sizes vary. +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.43 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan foobar 20 +} -cleanup { + destroy .e +} -returnCodes error -result {bad scan option "foobar": must be mark or dragto} +test entry-3.47 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan mark 20.1 +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "20.1"} -test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { - .e delete 0 end +# This test is non-portable because character sizes vary. +test entry-3.48 {EntryWidgetCmd procedure, "scan" widget command} -constraints { + fonts +} -setup { + entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 + pack .e update +} -body { .e insert end "This is quite a long string, in fact a " .e insert end "very very long string" .e scan mark 30 .e scan dragto 28 .e index @0 -} {2} -test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} { - list [catch {.e select} msg] $msg -} {1 {wrong # args: should be ".e selection option ?index?"}} -test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} { - list [catch {.e select foo} msg] $msg -} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}} -test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} { - list [catch {.e select clear gorp} msg] $msg -} {1 {wrong # args: should be ".e selection clear"}} -test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2} +test entry-3.49 {EntryWidgetCmd procedure, "select" widget command} -setup { + entry .e +} -body { + .e select +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection option ?index?"} +test entry-3.50 {EntryWidgetCmd procedure, "select" widget command} -setup { + entry .e +} -body { + .e select foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad selection option "foo": must be adjust, clear, from, present, range, or to} + +test entry-3.51 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e +} -body { + .e select clear gorp +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection clear"} +test entry-3.52 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 4 update .e select clear - list [catch {selection get} msg] $msg [selection own] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} -test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} { - list [catch {.e selection present foo} msg] $msg -} {1 {wrong # args: should be ".e selection present"}} -test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test entry-3.53 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e + pack .e + update +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 4 + update + .e select clear + catch {selection get} + selection own +} -cleanup { + destroy .e +} -result {.e} + +test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e +} -body { + .e selection present foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection present"} +test entry-3.55 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present -} {1} -test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-3.56 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e configure -exportselection false .e selection present -} {1} -.e configure -exportselection true -test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-3.57 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e delete 0 end .e selection present -} {0} -test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust x} msg] $msg -} {1 {bad entry index "x"}} -test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection adjust index"}} -test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0} +test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e +} -body { + .e select adjust x +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "x"} +test entry-3.59 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e +} -body { + .e select adjust 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection adjust index"} +test entry-3.60 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 4 selection get -} {123} -test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {123} +test entry-3.61 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 2 selection get -} {234} -test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} { - list [catch {.e select from 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection from index"}} -test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} { - list [catch {.e select range 2} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} { - list [catch {.e selection range 2 3 4} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {234} +test entry-3.62 {EntryWidgetCmd procedure, "selection from" widget command} -setup { + entry .e +} -body { + .e select from 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection from index"} + +test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { + .e select range 2 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test entry-3.64 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { + .e selection range 2 3 4 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test entry-3.65 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { .e insert end 0123456789 .e select from 1 .e select to 5 .e select range 4 4 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-3.66 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 7 .e select range 2 9 list [.e index sel.first] [.e index sel.last] [.e index anchor] -} {2 9 3} -test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 3} +test entry-3.67 {EntryWidgetCmd procedure, "selection" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e selection range 0 end .e configure -state disabled .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] -} {0 10} -test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0 10} +test entry-3.68 {EntryWidgetCmd procedure, "selection" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e selection range 0 end .e configure -state readonly .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] -} {2 4} -.e delete 0 end -.e insert end "This is quite a long text string, so long that it " -.e insert end "runs off the end of the window quite a bit." -test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} { - list [catch {.e select to 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection to index"}} -test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {2 4} +test entry-3.69 {EntryWidgetCmd procedure, "selection to" widget command} -setup { + entry .e + pack .e + update + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." +} -body { + .e select to 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection to index"} + +test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 5 .e xview -} {0.0537634 0.268817} -test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview gorp} msg] $msg -} {1 {bad entry index "gorp"}} -test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.0537634 0.268817} +test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "gorp"} +test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 .e icursor 10 .e xview insert .e xview -} {0.107527 0.322581} -test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo bar} msg] $msg -} {1 {wrong # args: should be ".e xview moveto fraction"}} -test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo} msg] $msg -} {1 {expected floating-point number but got "foo"}} -test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.107527 0.322581} +test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo bar +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} +test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo +} -cleanup { + destroy .e +} -returnCodes error -result {expected floating-point number but got "foo"} +test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto 0.5 .e xview -} {0.505376 0.72043} -test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 24} msg] $msg -} {1 {wrong # args: should be ".e xview scroll number units|pages"}} -test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll gorp units} msg] $msg -} {1 {expected integer but got "gorp"}} -test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.505376 0.72043} +test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e xview scroll 24 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll gorp units +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "gorp"} +test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview moveto 0 .e xview scroll 1 pages .e xview -} {0.193548 0.408602} -test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.193548 0.408602} +test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto .9 update .e xview scroll -2 p .e xview -} {0.397849 0.612903} -test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.397849 0.612903} +test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll 2 units .e index @0 -} {32} -test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {32} +test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll -1 units .e index @0 -} {29} -test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 23 foobars} msg] $msg -} {1 {bad argument "foobars": must be units or pages}} -test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview eat 23 hamburgers} msg] $msg -} {1 {unknown option "eat": must be moveto or scroll}} -test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {29} +test entry-3.82 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll 23 foobars +} -cleanup { + destroy .e +} -returnCodes error -result {bad argument "foobars": must be units or pages} +test entry-3.83 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview eat 23 hamburgers +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "eat": must be moveto or scroll} +test entry-3.84 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 update .e xview -4 .e index @0 -} {0} -test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0} +test entry-3.85 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 300 .e index @0 -} {73} -.e insert 10 \u4e4e -test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} { - # UTF - # If Tcl_NumUtfChars wasn't used, wrong answer would be: - # 0.106383 0.117021 0.117021 - +} -cleanup { + destroy .e +} -result {73} +test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e insert 10 \u4e4e + update +# UTF +# If Tcl_NumUtfChars wasn't used, wrong answer would be: +# 0.106383 0.117021 0.117021 set x {} .e xview moveto .1 lappend x [lindex [.e xview] 0] @@ -546,261 +1553,382 @@ test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} { lappend x [lindex [.e xview] 0] .e xview moveto .12 lappend x [lindex [.e xview] 0] -} {0.0957447 0.106383 0.117021} -test entry-3.82 {EntryWidgetCmd procedure} { - list [catch {.e gorp} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} +} -cleanup { + destroy .e +} -result {0.0957447 0.106383 0.117021} + +test entry-3.87 {EntryWidgetCmd procedure} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview} # The test below doesn't actually check anything directly, but if run # with Purify or some other memory-allocation-checking program it will # ensure that resources get properly freed. -test entry-4.1 {DestroyEntry procedure} { - catch {destroy .e} +test entry-4.1 {DestroyEntry procedure} -body { entry .e -textvariable x -show * pack .e .e insert end "Sample text" update destroy .e -} {} +} -result {} -frame .f -width 200 -height 50 -relief raised -bd 2 -pack .f -side right -test entry-5.1 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} +test entry-5.1 {ConfigureEntry procedure, -textvariable} -body { set x 12345 entry .e -textvariable x .e get -} {12345} -test entry-5.2 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {12345} +test entry-5.2 {ConfigureEntry procedure, -textvariable} -body { set x 12345 entry .e -textvariable x set y abcde .e configure -textvariable y set x 54321 .e get -} {abcde} -test entry-5.3 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} - catch {unset x} +} -cleanup { + destroy .e +} -result {abcde} +test entry-5.3 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x entry .e +} -body { .e insert 0 "Some text" .e configure -textvariable x - set x -} {Some text} -test entry-5.4 {ConfigureEntry procedure, -textvariable} { - proc override args { - global x - set x 12345 - } - catch {destroy .e} - catch {unset x} - trace variable x w override + return $x +} -cleanup { + destroy .e +} -result {Some text} +test entry-5.4 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x entry .e +} -body { + trace variable x w override .e insert 0 "Some text" .e configure -textvariable x - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} -test entry-5.5 {ConfigureEntry procedure} { - catch {destroy .e} - entry .e -exportselection false - pack .e - .e insert end "0123456789" - .sel select from 0 - .sel select to 10 + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override + unset x; +} -result {12345 12345} + +test entry-5.5 {ConfigureEntry procedure} -setup { set x {} + entry .e1 + entry .e2 +} -body { + .e2 insert end "This is some sample text" + .e1 configure -exportselection false + .e1 insert end "0123456789" + pack .e1 .e2 + .e2 select from 0 + .e2 select to 10 lappend x [selection get] - .e select from 1 - .e select to 5 + .e1 select from 1 + .e1 select to 5 lappend x [selection get] - .e configure -exportselection 1 + .e1 configure -exportselection 1 lappend x [selection get] - set x -} {{This is so} {This is so} 1234} -test entry-5.6 {ConfigureEntry procedure} { - catch {destroy .e} + return $x +} -cleanup { + destroy .e1 .e2 +} -result {{This is so} {This is so} 1234} +test entry-5.6 {ConfigureEntry procedure} -setup { + entry .e + pack .e +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 5 + .e configure -exportselection 0 + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test entry-5.7 {ConfigureEntry procedure} -setup { entry .e pack .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 .e configure -exportselection 0 - list [catch {selection get} msg] $msg [.e index sel.first] \ - [.e index sel.last] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} -test entry-5.7 {ConfigureEntry procedure} { - catch {destroy .e} - entry .e -font $fixed -width 4 -xscrollcommand scroll + catch {selection get} + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 5} + +test entry-5.8 {ConfigureEntry procedure} -setup { + entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" update .e configure -width 5 - set scrollInfo -} {0 0.363636} -test entry-5.8 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -width 0 + return $scrollInfo +} -cleanup { + destroy .e +} -result {0 0.363636} + + +test entry-5.9 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -width 0 -font {Helvetica -12} .e insert end "0123" update - .e configure -font $big + .e configure -font {Helvetica -24} update winfo geom .e -} {62x37+0+0} -test entry-5.9 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised +} -cleanup { + destroy .e +} -result {62x37+0+0} +test entry-5.10 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test entry-5.10 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief flat +} -cleanup { + destroy .e +} -result {0 0 1 1} +test entry-5.11 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test entry-5.11 {ConfigureEntry procedure} { - # If "0" in selected font had 0 width, caused divide-by-zero error. - - catch {destroy .e} - pack [entry .e -font {{open look glyph}}] +} -cleanup { + destroy .e +} -result {0 0 1 1} +test entry-5.12 {ConfigureEntry procedure} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e +} -body { +# If "0" in selected font had 0 width, caused divide-by-zero error. + .e configure -font {{open look glyph}} .e scan dragto 30 update -} {} +} -cleanup { + destroy .e +} -result {} # No tests for DisplayEntry. -test entry-6.1 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 +test entry-6.1 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @61] [.e index @62] -} {3 4} -test entry-6.2 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.2 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -justify center -highlightthickness 3 .e insert end 012\t45 update list [.e index @96] [.e index @97] -} {3 4} -test entry-6.3 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.3 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -justify right -highlightthickness 3 .e insert end 012\t45 update list [.e index @131] [.e index @132] -} {3 4} -test entry-6.4 {EntryComputeGeometry procedure} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.4 {EntryComputeGeometry procedure} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 .e index @0 -} {6} -test entry-6.5 {EntryComputeGeometry procedure} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {6} +test entry-6.5 {EntryComputeGeometry procedure} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 .e index @0 -} {6} -test entry-6.6 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 10 +} -cleanup { + destroy .e +} -result {6} +test entry-6.6 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 list [.e index @39] [.e index @40] -} {5 6} -test entry-6.7 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {5 6} +test entry-6.7 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {77 39} -test entry-6.8 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 0 +} -cleanup { + destroy .e +} -result {77 39} +test entry-6.8 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {116 39} -test entry-6.9 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 +} -cleanup { + destroy .e +} -result {116 39} +test entry-6.9 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] -} {25 39} -test entry-6.10 {EntryComputeGeometry procedure} {unix fonts} { - catch {destroy .e} - entry .e -bd 1 -relief raised -width 0 -show . - .e insert 0 12345 +} -cleanup { + destroy .e +} -result {25 39} +test entry-6.10 {EntryComputeGeometry procedure} -constraints { + unix fonts +} -setup { + entry .e -highlightthickness 2 -font {Helvetica -12} pack .e +} -body { + .e configure -bd 1 -relief raised -width 0 -show . + .e insert 0 12345 update set x [winfo reqwidth .e] .e configure -show X lappend x [winfo reqwidth .e] .e configure -show "" lappend x [winfo reqwidth .e] -} {23 53 43} -test entry-6.11 {EntryComputeGeometry procedure} win { - catch {destroy .e} - entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12} - .e insert 0 12345 +} -cleanup { + destroy .e +} -result {23 53 43} +test entry-6.11 {EntryComputeGeometry procedure} -constraints { + win +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -bd 1 -relief raised -width 0 -show . -font {helvetica 12} + .e insert 0 12345 update - set x [winfo reqwidth .e] + set x1 [winfo reqwidth .e] + set x2 [expr {8+5*[font measure {helvetica 12} .]}] + set x [expr {$x1 eq $x2}] .e configure -show X - lappend x [winfo reqwidth .e] + set x1 [winfo reqwidth .e] + set x2 [expr {8+5*[font measure {helvetica 12} X]}] + lappend x [expr {$x1 eq $x2}] .e configure -show "" - lappend x [winfo reqwidth .e] -} [list \ - [expr 8+5*[font measure {helvetica 12} .]] \ - [expr 8+5*[font measure {helvetica 12} X]] \ - [expr 8+[font measure {helvetica 12} 12345]]] - -catch {destroy .e} -entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll -pack .e -focus .e -test entry-7.1 {InsertChars procedure} { - .e delete 0 end + set x1 [winfo reqwidth .e] + set x2 [expr {8+[font measure {helvetica 12} 12345]}] + lappend x [expr {$x1 eq $x2}] +} -cleanup { + destroy .e +} -result {1 1 1} + + +test entry-7.1 {InsertChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 2 XXX update list [.e get] $contents $scrollInfo -} {abXXXcde abXXXcde {0 1}} -test entry-7.2 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abXXXcde abXXXcde {0 1}} + +test entry-7.2 {InsertChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 500 XXX update list [.e get] $contents $scrollInfo -} {abcdeXXX abcdeXXX {0 1}} -test entry-7.3 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abcdeXXX abcdeXXX {0 1}} +test entry-7.3 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -808,9 +1936,13 @@ test entry-7.3 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {5 9 5 8} -test entry-7.4 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {5 9 5 8} +test entry-7.4 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -818,9 +1950,13 @@ test entry-7.4 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test entry-7.5 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test entry-7.5 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -828,9 +1964,13 @@ test entry-7.5 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test entry-7.6 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test entry-7.6 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -838,70 +1978,118 @@ test entry-7.6 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {2 6 2 5} -test entry-7.7 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 6 2 5} +test entry-7.7 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -xscrollcommand scroll .e insert 0 0123456789 .e icursor 4 .e insert 4 XXX .e index insert -} {7} -test entry-7.8 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test entry-7.8 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e icursor 4 .e insert 5 XXX .e index insert -} {4} -test entry-7.9 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-7.9 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 3 XXX .e index @0 -} {7} -test entry-7.10 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test entry-7.10 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 4 XXX .e index @0 -} {4} -.e configure -width 0 -test entry-7.11 {InsertChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} + +test entry-7.11 {InsertChars procedure} -constraints { + fonts +} -setup { + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "xyzzy" update .e insert 2 00 winfo reqwidth .e -} {59} +} -cleanup { + destroy .e +} -result {59} -.e configure -width 10 -test entry-8.1 {DeleteChars procedure} { - .e delete 0 end +test entry-8.1 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 2 4 update list [.e get] $contents $scrollInfo -} {abe abe {0 1}} -test entry-8.2 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abe abe {0 1}} +test entry-8.2 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete -2 2 update list [.e get] $contents $scrollInfo -} {cde cde {0 1}} -test entry-8.3 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {cde cde {0 1}} +test entry-8.3 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 3 1000 update list [.e get] $contents $scrollInfo -} {abc abc {0 1}} -test entry-8.4 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abc abc {0 1}} +test entry-8.4 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -910,9 +2098,14 @@ test entry-8.4 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 6 1 5} -test entry-8.5 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 6 1 5} +test entry-8.5 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -921,9 +2114,14 @@ test entry-8.5 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {1 5 1 4} -test entry-8.6 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 5 1 4} +test entry-8.6 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -932,17 +2130,28 @@ test entry-8.6 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 2 1 5} -test entry-8.7 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 2 1 5} +test entry-8.7 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-8.8 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-8.8 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -951,17 +2160,27 @@ test entry-8.8 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 4 3 8} -test entry-8.9 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 3 8} +test entry-8.9 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-8.10 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-8.10 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -970,9 +2189,14 @@ test entry-8.10 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 5 5 8} -test entry-8.11 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 5 5 8} +test entry-8.11 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -981,124 +2205,186 @@ test entry-8.11 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {3 8 4 8} -test entry-8.12 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 8 4 8} +test entry-8.12 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 4 + update .e index insert -} {1} -test entry-8.13 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.13 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 5 + update .e index insert -} {1} -test entry-8.14 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.14 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 4 6 + update .e index insert -} {4} -test entry-8.15 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-8.15 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 4 + update .e index @0 -} {1} -test entry-8.16 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.16 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 5 + update .e index @0 -} {1} -test entry-8.17 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.17 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 4 6 + update .e index @0 -} {4} -.e configure -width 0 -test entry-8.18 {DeleteChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-8.18 {DeleteChars procedure} -setup { + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "xyzzy" update .e delete 2 4 winfo reqwidth .e -} {31} +} -cleanup { + destroy .e +} -result {31} -test entry-9.1 {EntryValueChanged procedure} { - catch {destroy .e} - proc override args { - global x - set x 12345 - } - catch {unset x} +test entry-9.1 {EntryValueChanged procedure} -setup { + unset -nocomplain x +} -body { trace variable x w override - entry .e -textvariable x + entry .e -textvariable x -width 0 .e insert 0 foo - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} - -catch {destroy .e} -entry .e -pack .e -.e configure -width 0 -test entry-10.1 {EntrySetValue procedure} {fonts} { + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override + unset x +} -result {12345 12345} + + +test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab - .e configure -textvariable x - update + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + pack .e + .e configure -textvariable x .e configure -textvariable y update list [.e get] [winfo reqwidth .e] -} {ab 24} -test entry-10.2 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x +} -cleanup { + destroy .e +} -result {ab 24} +test entry-10.2 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "a" - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-10.3 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-10.3 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefg" list [.e index sel.first] [.e index sel.last] -} {4 7} -test entry-10.4 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x +} -cleanup { + destroy .e +} -result {4 7} +test entry-10.4 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefghijklmn" list [.e index sel.first] [.e index sel.last] -} {4 10} -test entry-10.5 {EntrySetValue procedure, updating display position} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {4 10} +test entry-10.5 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "abcdefg" update .e index @0 -} {0} -test entry-10.6 {EntrySetValue procedure, updating display position} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {0} +test entry-10.6 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 @@ -1106,192 +2392,463 @@ test entry-10.6 {EntrySetValue procedure, updating display position} { set x "1234567890123456789012" update .e index @0 -} {10} -test entry-10.7 {EntrySetValue procedure, updating insertion cursor} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {10} +test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e + update +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" .e index insert -} {3} -test entry-10.8 {EntrySetValue procedure, updating insertion cursor} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {3} +test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" .e index insert -} {5} +} -cleanup { + destroy .e +} -result {5} -test entry-11.1 {EntryEventProc procedure} { - catch {destroy .e} - entry .e +test entry-11.1 {EntryEventProc procedure} -setup { + entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + pack .e +} -body { .e insert 0 abcdefg destroy .e update -} {} -test entry-11.2 {EntryEventProc procedure} { - deleteWindows +} -cleanup { + destroy .e +} -result {} +test entry-11.2 {EntryEventProc procedure} -setup { + set x {} +} -body { entry .e1 -fg #112233 rename .e1 .e2 - set x {} lappend x [winfo children .] lappend x [.e2 cget -fg] destroy .e1 lappend x [info command .e*] [winfo children .] -} {.e1 #112233 {} {}} - -test entry-12.1 {EntryCmdDeletedProc procedure} { - deleteWindows - button .e1 -text "xyz_123" - rename .e1 {} - list [info command .e*] [winfo children .] -} {{} {}} - -catch {destroy .e} -entry .e -font $fixed -width 5 -bd 2 -relief sunken -pack .e -.e insert 0 012345678901234567890 -.e xview 4 -update -test entry-13.1 {GetEntryIndex procedure} { +} -cleanup { + destroy .e1 +} -result {.e1 #112233 {} {}} + +test entry-12.1 {EntryCmdDeletedProc procedure} -body { + button .b -text "xyz_123" + rename .b {} + list [info command .b*] [winfo children .] +} -cleanup { + destroy .b +} -result {{} {}} + + +test entry-13.1 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e index end -} {21} -test entry-13.2 {GetEntryIndex procedure} { - list [catch {.e index abogus} msg] $msg -} {1 {bad entry index "abogus"}} -test entry-13.3 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {21} +test entry-13.2 {GetEntryIndex procedure} -body { + entry .e + .e index abogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "abogus"} +test entry-13.3 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 .e index anchor -} {1} -test entry-13.4 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {1} +test entry-13.4 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 4 .e select to 1 .e index anchor -} {4} -test entry-13.5 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.5 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 3 .e select to 15 .e select adjust 4 .e index anchor -} {15} -test entry-13.6 {GetEntryIndex procedure} { - list [catch {.e index ebogus} msg] $msg -} {1 {bad entry index "ebogus"}} -test entry-13.7 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {15} +test entry-13.6 {GetEntryIndex procedure} -setup { + entry .e +} -body { + .e index ebogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "ebogus"} +test entry-13.7 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e icursor 2 .e index insert -} {2} -test entry-13.8 {GetEntryIndex procedure} { - list [catch {.e index ibogus} msg] $msg -} {1 {bad entry index "ibogus"}} -test entry-13.9 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {2} +test entry-13.8 {GetEntryIndex procedure} -setup { + entry .e +} -body { + .e index ibogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "ibogus"} +test entry-13.9 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 6} + +test entry-13.10 {GetEntryIndex procedure} -constraints unix -body { +# On unix, when selection is cleared, entry widget's internal +# selection range is reset. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 list [.e index sel.first] [.e index sel.last] -} {1 6} -selection clear .e -test entry-13.10 {GetEntryIndex procedure} unix { - # On unix, when selection is cleared, entry widget's internal - # selection range is reset. - - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-13.11 {GetEntryIndex procedure} win { - # On mac and pc, when selection is cleared, entry widget remembers - # last selected range. When selection ownership is restored to - # entry, the old range will be rehighlighted. - - list [catch {selection get}] [.e index sel.first] -} {1 1} -test entry-13.12 {GetEntryIndex procedure} unix { - list [catch {.e index sbogus} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-13.13 {GetEntryIndex procedure} win { - list [catch {.e index sbogus} msg] $msg -} {1 {bad entry index "sbogus"}} -test entry-13.14 {GetEntryIndex procedure} win { - list [catch {selection get}] [catch {.e index sbogus}] -} {1 1} -test entry-13.15 {GetEntryIndex procedure} { - list [catch {.e index @xyz} msg] $msg -} {1 {bad entry index "@xyz"}} -test entry-13.16 {GetEntryIndex procedure} {fonts} { +# Testing: + selection clear .e + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-13.11 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +# why when string in .e index changed to not beginning with s, +# it behaves differently? +test entry-13.12 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bogus"} + +test entry-13.13 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + selection get +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} +test entry-13.14 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sel.first +} -cleanup { + destroy .e +} -result {1} +test entry-13.15 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} +test entry-13.16 {GetEntryIndex procedure} -constraints win -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "sbogus"} + +test entry-13.17 {GetEntryIndex procedure} -body { + entry .e + selection clear .e + .e index @xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "@xyz"} + +test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @4 -} {4} -test entry-13.17 {GetEntryIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @11 -} {4} -test entry-13.18 {GetEntryIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @12 -} {5} -test entry-13.19 {GetEntryIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 6] -} {8} -test entry-13.20 {GetEntryIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 5] -} {9} -test entry-13.21 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {5} +test entry-13.21 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 6}] +} -cleanup { + destroy .e +} -result {8} +test entry-13.22 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 5}] +} -cleanup { + destroy .e +} -result {9} +test entry-13.23 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @1000 -} {9} -test entry-13.22 {GetEntryIndex procedure} { - list [catch {.e index 1xyz} msg] $msg -} {1 {bad entry index "1xyz"}} -test entry-13.23 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {9} +test entry-13.24 {GetEntryIndex procedure} -setup { + entry .e + pack .e + update +} -body { + .e index 1xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "1xyz"} +test entry-13.25 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index -10 -} {0} -test entry-13.24 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {0} +test entry-13.26 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 12 -} {12} -test entry-13.25 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {12} +test entry-13.27 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 49 -} {21} -test entry-13.26 {GetEntryIndex procedure} {fonts} { - catch {destroy .e} - entry .e -show . +} -cleanup { + destroy .e +} -result {21} +test entry-13.28 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + selection clear .e + .e configure -show . .e insert 0 XXXYZZY pack .e update list [.e index @7] [.e index @8] -} {0 1} +} -cleanup { + destroy .e +} -result {0 1} # XXX Still need to write tests for EntryScanTo and EntrySelectTo. -set x {} -for {set i 1} {$i <= 500} {incr i} { - append x "This is line $i, out of 500\n" -} -test entry-14.1 {EntryFetchSelection procedure} { - catch {destroy .e} + +test entry-14.1 {EntryFetchSelection procedure} -body { entry .e .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {his is a test str} -test entry-14.2 {EntryFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {his is a test str} +test entry-14.2 {EntryFetchSelection procedure} -body { entry .e -show * .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {*****************} -test entry-14.3 {EntryFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {*****************} +test entry-14.3 {EntryFetchSelection procedure} -setup { + set x {} + for {set i 1} {$i <= 500} {incr i} { + append x "This is line $i, out of 500\n" +} +} -body { entry .e - .e insert end $x + .e insert end $x .e select from 0 .e select to end string compare [selection get] $x -} 0 +} -cleanup { + destroy .e +} -result {0} -test entry-15.1 {EntryLostSelection} { - catch {destroy .e} +test entry-15.1 {EntryLostSelection} -body { entry .e .e insert 0 "Text" .e select from 0 @@ -1301,334 +2858,617 @@ test entry-15.1 {EntryLostSelection} { .e select from 0 .e select to 4 lappend result [selection get] -} {Text Text} - -# No tests for EventuallyRedraw. - -catch {destroy .e} -entry .e -width 10 -xscrollcommand scroll -pack .e -update +} -cleanup { + destroy .e +} -result {Text Text} -test entry-16.1 {EntryVisibleRange procedure} {fonts} { - .e delete 0 end - .e insert 0 ............................. +# is scrollcommand needed here?? +test entry-16.1 {EntryVisibleRange procedure} -constraints fonts -body { + entry .e -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." .e xview -} {0 0.827586} -test entry-15.2 {EntryVisibleRange procedure} {unix fonts} { - .e configure -show X - .e delete 0 end - .e insert 0 ............................. +} -cleanup { + destroy .e +} -result {0 0.827586} +test entry-16.2 {EntryVisibleRange procedure} -constraints { + unix fonts +} -body { + entry .e -show X -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." .e xview -} {0 0.275862} -test entry-15.3 {EntryVisibleRange procedure} win { - .e configure -show . - .e delete 0 end +} -cleanup { + destroy .e +} -result {0 0.275862} +test entry-16.3 {EntryVisibleRange procedure} -constraints { + win +} -body { + entry .e -show . -width 10 -font {Helvetica -12} + pack .e + update .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX .e xview -} {0 0.827586} -.e configure -show "" -test entry-15.4 {EntryVisibleRange procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0 0.827586} +test entry-16.4 {EntryVisibleRange procedure} -body { + entry .e -show "" .e xview -} {0 1} +} -cleanup { + destroy .e +} -result {0 1} + -catch {destroy .e} -entry .e -width 10 -xscrollcommand scroll -font $fixed -pack .e -update -test entry-17.1 {EntryUpdateScrollbar procedure} { +test entry-17.1 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e delete 0 end .e insert 0 123 update - set scrollInfo -} {0 1} -test entry-17.2 {EntryUpdateScrollbar procedure} { - .e delete 0 end + return $scrollInfo +} -cleanup { + destroy .e +} -result {0 1} +test entry-17.2 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 0123456789abcdef .e xview 3 update - set scrollInfo -} {0.1875 0.8125} -test entry-17.3 {EntryUpdateScrollbar procedure} { - .e delete 0 end + return $scrollInfo +} -cleanup { + destroy .e +} -result {0.1875 0.8125} +test entry-17.3 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 abcdefghijklmnopqrs .e xview 6 update - set scrollInfo -} {0.315789 0.842105} -test entry-17.4 {EntryUpdateScrollbar procedure} { + return $scrollInfo +} -cleanup { destroy .e +} -result {0.315789 0.842105} +test entry-17.4 {EntryUpdateScrollbar procedure} -setup { proc bgerror msg { global x set x $msg - } +} +} -body { entry .e -width 5 -xscrollcommand thisisnotacommand pack .e update - rename bgerror {} list $x $errorInfo -} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" +} -cleanup { + destroy .e + rename bgerror {} +} -result {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0 1" (horizontal scrolling command executed by .e)}} -set l [interp hidden] -deleteWindows -test entry-18.1 {Entry widget vs hiding} { - destroy .e +test entry-18.1 {Entry widget vs hiding} -setup { entry .e +} -body { + set l [interp hidden] interp hide {} .e destroy .e - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -result {1} ## ## Entry widget VALIDATION tests ## - -destroy .e -catch {unset ::e} -catch {unset ::vVals} -entry .e -validate all \ - -validatecommand [list doval %W %d %i %P %s %S %v %V] \ - -invalidcommand bell \ - -textvariable ::e \ - -background red -foreground white -pack .e -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 1 -} - # The validation tests build each one upon the previous, so cascading # failures aren't good # -test entry-19.1 {entry widget validation} { + +# 19.* test cases in previous version highly depended on the previous +# test cases. This was replaced by inserting recently set configurations +# that matters for the test case +test entry-19.1 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e .e insert 0 a - set ::vVals -} {.e 1 0 a {} a all key} -test entry-19.2 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 0 a {} a all key} + +test entry-19.2 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a ;# previous settings .e insert 1 b - set ::vVals -} {.e 1 1 ab a b all key} -test entry-19.3 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 1 ab a b all key} + +test entry-19.3 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 ab ;# previous settings .e insert end c - set ::vVals -} {.e 1 2 abc ab c all key} -test entry-19.4 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 2 abc ab c all key} + +test entry-19.4 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e -} {{.e 1 1 a123bc abc 123 all key} a123bc} -test entry-19.5 {entry widget validation} { +} -cleanup { + destroy .e +} -result {{.e 1 1 a123bc abc 123 all key} a123bc} + +test entry-19.5 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a123bc ;# previous settings .e delete 2 - set ::vVals -} {.e 0 2 a13bc a123bc 2 all key} -test entry-19.6 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 2 a13bc a123bc 2 all key} + +test entry-19.6 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 - set ::vVals -} {.e 0 1 abc a13bc 13 key key} -test entry-19.7 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 1 abc a13bc 13 key key} + +test entry-19.7 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abc ;# previous settings set ::vVals {} - .e configure -validate focus .e insert end d - set ::vVals -} {} -test entry-19.8 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.8 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e configure -validate focus ;# previous settings + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusin} -test entry-19.9 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusin} + +test entry-19.9 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings + update ;# previous settings +# update necessary to process FocusIn event focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusout} -.e configure -validate all -test entry-19.10 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusout} + +test entry-19.10 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusin} -test entry-19.11 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusin} + +test entry-19.11 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusout} -.e configure -validate focusin -test entry-19.12 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusout} + +test entry-19.12 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusin focusin} -test entry-19.13 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusin focusin} + +test entry-19.13 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::vVals {} focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {} -.e configure -validate focuso -test entry-19.14 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.14 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {} -test entry-19.15 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.15 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings + focus -force . +# update necessary to process FocusOut event + update + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusout focusout} + +# the same as 19.16 but added [.e validate] to returned list +test entry-19.16 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusout focusout} -test entry-19.16 {entry widget validation} { list [.e validate] $::vVals -} {1 {.e -1 -1 abcd abcd {} all forced}} -test entry-19.17 {entry widget validation} { +} -cleanup { + destroy .e +} -result {1 {.e -1 -1 abcd abcd {} all forced}} + + +test entry-19.17 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals -} {focusout {.e -1 -1 newdata abcd {} focusout forced}} +} -cleanup { + destroy .e +} -result {focusout {.e -1 -1 newdata abcd {} focusout forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 0 -} -test entry-19.18 {entry widget validation} { +# proc doval changed - returns 0 +test entry-19.18 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e newdata ;# previous settings .e configure -validate all set ::e nextdata list [.e cget -validate] $::vVals -} {none {.e -1 -1 nextdata newdata {} all forced}} - -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - set ::e mydata - return 1 -} +} -cleanup { + destroy .e +} -result {none {.e -1 -1 nextdata newdata {} all forced}} ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set -test entry-19.19 {entry widget validation} { - .e configure -validate all +# proc doval2 used +test entry-19.19 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] .e validate list [.e cget -validate] [.e get] $::vVals -} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} +} -cleanup { + destroy .e +} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the entry widget shown as is in the textvar. -test entry-19.20 {entry widget validation} { +test entry-19.20 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev + .e validate ;# previous settings + .e configure -validate all set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals -} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} - -destroy .e -catch {unset ::e ::vVals} - +} -cleanup { + destroy .e +} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} ## ## End validation tests ## -test entry-20.1 {widget deletion while active} { - destroy .e +test entry-20.1 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { destroy %W ; return 1 } \ -invalidcommand bell update .e insert 0 abc winfo exists .e -} 0 -test entry-20.2 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.2 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { return 0 } \ -invalidcommand { destroy %W } .e insert 0 abc winfo exists .e -} 0 -test entry-20.3 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.3 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { rename .e {} ; return 1 } .e insert 0 abc winfo exists .e -} 0 -test entry-20.4 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.4 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { return 0 } \ -invalidcommand { rename .e {} } .e insert 0 abc winfo exists .e -} 0 -test entry-20.5 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.5 {widget deletion while active} -body { entry .e -validatecommand { destroy .e ; return 0 } .e validate winfo exists .e -} 0 -test entry-20.6 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.6 {widget deletion while active} -body { pack [entry .e] update .e config -xscrollcommand { destroy .e } update idle winfo exists .e -} 0 -test entry-20.7 {widget deletion with textvariable active} { - # SF bugs 607390 and 617446 +} -cleanup { destroy .e +} -result {0} + +test entry-20.7 {widget deletion with textvariable active} -body { +# SF bugs 607390 and 617446 set FOO init entry .e -textvariable FOO -validate all \ -vcmd {%W configure -bg white; format 1} bind .e <Destroy> { set FOO hello } destroy .e winfo exists .e -} 0 - -test entry-21.1 {selection present while disabled, bug 637828} { +} -cleanup { destroy .e +} -result {0} + + +test entry-21.1 {selection present while disabled, bug 637828} -body { entry .e .e insert end 0123456789 .e select from 3 .e select to 6 set out [.e selection present] .e configure -state disabled - # still return 1 when disabled, because 'selection get' will work, - # but selection cannot be changed (new behavior since 8.4) +# still return 1 when disabled, because 'selection get' will work, +# but selection cannot be changed (new behavior since 8.4) .e select to 9 lappend out [.e selection present] [selection get] -} {1 1 345} - -test entry-22.1 {lost namespaced textvar} { +} -cleanup { destroy .e +} -result {1 1 345} + +test entry-22.1 {lost namespaced textvar} -body { namespace eval test { variable foo {a b} } entry .e -textvariable ::test::foo namespace delete test .e insert end "more stuff" .e delete 5 end - catch {set ::test::foo} result - list [.e get] [.e cget -textvar] $result -} [list "a bmo" ::test::foo \ - {can't read "::test::foo": no such variable}] - -destroy .e + set ::test::foo +} -cleanup { + destroy .e +} -returnCodes error -result {can't read "::test::foo": no such variable} +test entry-22.2 {lost namespaced textvar} -body { + namespace eval test { variable foo {a b} } + entry .e -textvariable ::test::foo + namespace delete test + .e insert end "more stuff" + .e delete 5 end + catch {set ::test::foo} + list [.e get] [.e cget -textvar] +} -cleanup { + destroy .e +} -result [list "a bmo" ::test::foo] +# Gathered comments about lacks # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. +# No tests for DisplayEntry. +# XXX Still need to write tests for EntryScanTo and EntrySelectTo. +# No tests for EventuallyRedraw -option clear - +# option clear # cleanup cleanupTests return + + + diff --git a/tests/spinbox.test b/tests/spinbox.test index ca84c5c..6a7cc2a 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -1,240 +1,1242 @@ # This file is a Tcl script to test spinbox widgets in Tk. It is # organized in the standard fashion for Tcl tests. # -# Copyright (c) 1998-2000 by Scriptics Corporation. +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: spinbox.test,v 1.9 2004/06/24 12:45:43 dkf Exp $ +# RCS: @(#) $Id: spinbox.test,v 1.10 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 +# For xscrollcommand proc scroll args { - global scrollInfo - set scrollInfo $args + global scrollInfo + set scrollInfo $args +} +# For trace variable +proc override args { + global x + set x 12345 } -# Create additional widget that's used to hold the selection at times. - -spinbox .sel -.sel insert end "This is some sample text" - -# Font names - -set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 -set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 - -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. - -option add *Spinbox.borderWidth 2 -option add *Spinbox.highlightThickness 2 -option add *Spinbox.font {Helvetica -12} - -spinbox .e -bd 2 -relief sunken -pack .e -update - -set i 1 -foreach test { - {-activebackground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-buttonbackground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}} - {-command {a command} {a command} {} {}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledbackground green green non-existent - {unknown color name "non-existent"}} - {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} - {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} - {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}} - {-from -10 -10.0 bogus {expected floating-point number but got "bogus"}} - {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} - {-highlightthickness -2 0 {} {}} - {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}} - {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} - {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} - {-insertontime 100 100 3.2 {expected integer but got "3.2"}} - {-invalidcommand "a command" "a command" {} {}} - {-invcmd "a command" "a command" {} {}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-readonlybackground green green non-existent - {unknown color name "non-existent"}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-repeatdelay 500 500 3p {expected integer but got "3p"}} - {-repeatinterval -500 -500 3p {expected integer but got "3p"}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} - {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}} - {-takefocus "any string" "any string" {} {}} - {-textvariable i i {} {}} - {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}} - {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}} - {-validatecommand "a command" "a command" {} {}} - {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}} - {-vcmd "a command" "a command" {} {}} - {-width 402 402 3p {expected integer but got "3p"}} - {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-xscrollcommand {Some command} {Some command} {} {}} -} { - set name [lindex $test 0] - test spinbox-1.$i {configuration options} { - .e configure $name [lindex $test 1] - list [lindex [.e configure $name] 4] [.e cget $name] - } [list [lindex $test 2] [lindex $test 2]] - incr i - if {[lindex $test 3] != ""} { - test spinbox-1.$i {configuration options} { - list [catch {.e configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .e configure $name [lindex [.e configure $name] 3] - incr i +# Procedures used in widget VALIDATION tests +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 1 +} +proc doval2 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + set ::e mydata + return 1 +} +proc doval3 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 0 } -test spinbox-2.1 {Tk_SpinboxCmd procedure} { - list [catch {spinbox} msg] $msg -} {1 {wrong # args: should be "spinbox pathName ?options?"}} -test spinbox-2.2 {Tk_SpinboxCmd procedure} { - list [catch {spinbox gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test spinbox-2.3 {Tk_SpinboxCmd procedure} { - catch {destroy .e} +set cy [font metrics {Courier -12} -linespace] + +test spinbox-1.1 {configuration option: "activebackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -activebackground #ff0000 + .e cget -activebackground +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.2 {configuration option: "activebackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -activebackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.3 {configuration option: "background"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -background #ff0000 + .e cget -background +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.4 {configuration option: "background" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -background non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.5 {configuration option: "bd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bd 4 + .e cget -bd +} -cleanup { + destroy .e +} -result {4} +test spinbox-1.6 {configuration option: "bd" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bd badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.7 {configuration option: "bg"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bg #ff0000 + .e cget -bg +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.8 {configuration option: "bg" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.9 {configuration option: "borderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -borderwidth 1.3 + .e cget -borderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.10 {configuration option: "borderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -borderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.11 {configuration option: "buttonbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttonbackground #ff0000 + .e cget -buttonbackground +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.12 {configuration option: "buttonbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttonbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.13 {configuration option: "buttoncursor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttoncursor arrow + .e cget -buttoncursor +} -cleanup { + destroy .e +} -result {arrow} +test spinbox-1.14 {configuration option: "buttoncursor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttoncursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test spinbox-1.15 {configuration option: "command"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -command {a command} + .e cget -command +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.16 {configuration option: "cursor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -cursor arrow + .e cget -cursor +} -cleanup { + destroy .e +} -result {arrow} +test spinbox-1.17 {configuration option: "cursor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -cursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test spinbox-1.18 {configuration option: "disabledbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledbackground green + .e cget -disabledbackground +} -cleanup { + destroy .e +} -result {green} +test spinbox-1.19 {configuration option: "disabledbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.20 {configuration option: "disabledforeground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledforeground #110022 + .e cget -disabledforeground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.21 {configuration option: "disabledforeground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledforeground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.22 {configuration option: "exportselection"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -exportselection yes + .e cget -exportselection +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.23 {configuration option: "exportselection" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -exportselection xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test spinbox-1.24 {configuration option: "fg"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -fg #110022 + .e cget -fg +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.25 {configuration option: "fg" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -fg bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.26 {configuration option: "font"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + .e cget -font +} -cleanup { + destroy .e +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} +test spinbox-1.27 {configuration option: "font" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -font {} +} -cleanup { + destroy .e +} -returnCodes {error} -result {font "" doesn't exist} + +test spinbox-1.28 {configuration option: "foreground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -foreground #110022 + .e cget -foreground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.29 {configuration option: "foreground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -foreground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.30 {configuration option: "format"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -format %0.5f + .e cget -format +} -cleanup { + destroy .e +} -result {%0.5f} +test spinbox-1.31 {configuration option: "format" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -format %d +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%d"} + +test spinbox-1.32 {configuration option: "from"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -from -10 + .e cget -from +} -cleanup { + destroy .e +} -result {-10.0} +test spinbox-1.33 {configuration option: "from" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -from bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.34 {configuration option: "highlightbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightbackground #123456 + .e cget -highlightbackground +} -cleanup { + destroy .e +} -result {#123456} +test spinbox-1.35 {configuration option: "highlightbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightbackground ugly +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "ugly"} + +test spinbox-1.36 {configuration option: "highlightcolor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightcolor #123456 + .e cget -highlightcolor +} -cleanup { + destroy .e +} -result {#123456} +test spinbox-1.37 {configuration option: "highlightcolor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightcolor bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.38 {configuration option: "highlightthickness"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness 6 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {6} +test spinbox-1.39 {configuration option: "highlightthickness" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "bogus"} + +test spinbox-1.40 {configuration option: "highlightthickness"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness -2 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {0} + +test spinbox-1.41 {configuration option: "increment"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -increment 1.0 + .e cget -increment +} -cleanup { + destroy .e +} -result {1.0} +test spinbox-1.42 {configuration option: "increment" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -increment bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.43 {configuration option: "insertbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertbackground #110022 + .e cget -insertbackground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.44 {configuration option: "insertbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertbackground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.45 {configuration option: "insertborderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertborderwidth 1.3 + .e cget -insertborderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.46 {configuration option: "insertborderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertborderwidth 2.6x +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "2.6x"} + +test spinbox-1.47 {configuration option: "insertofftime"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertofftime 100 + .e cget -insertofftime +} -cleanup { + destroy .e +} -result {100} +test spinbox-1.48 {configuration option: "insertofftime" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertofftime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test spinbox-1.49 {configuration option: "insertontime"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertontime 100 + .e cget -insertontime +} -cleanup { + destroy .e +} -result {100} +test spinbox-1.50 {configuration option: "insertontime" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertontime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test spinbox-1.51 {configuration option: "invalidcommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -invalidcommand "a command" + .e cget -invalidcommand +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.52 {configuration option: "invcmd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -invcmd "a command" + .e cget -invcmd +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.53 {configuration option: "justify"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -justify right + .e cget -justify +} -cleanup { + destroy .e +} -result {right} +test spinbox-1.54 {configuration option: "justify" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -justify bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test spinbox-1.55 {configuration option: "readonlybackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -readonlybackground green + .e cget -readonlybackground +} -cleanup { + destroy .e +} -result {green} +test spinbox-1.56 {configuration option: "readonlybackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -readonlybackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.57 {configuration option: "relief"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -relief groove + .e cget -relief +} -cleanup { + destroy .e +} -result {groove} +test spinbox-1.58 {configuration option: "relief" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -relief 1.5 +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test spinbox-1.59 {configuration option: "repeatdelay"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatdelay 500 + .e cget -repeatdelay +} -cleanup { + destroy .e +} -result {500} +test spinbox-1.60 {configuration option: "repeatdelay" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatdelay 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.61 {configuration option: "repeatinterval"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatinterval -500 + .e cget -repeatinterval +} -cleanup { + destroy .e +} -result {-500} +test spinbox-1.62 {configuration option: "repeatinterval" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatinterval 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.63 {configuration option: "selectbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectbackground #110022 + .e cget -selectbackground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.64 {configuration option: "selectbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectbackground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.65 {configuration option: "selectborderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectborderwidth 1.3 + .e cget -selectborderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.66 {configuration option: "selectborderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectborderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.67 {configuration option: "selectforeground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectforeground #654321 + .e cget -selectforeground +} -cleanup { + destroy .e +} -result {#654321} +test spinbox-1.68 {configuration option: "selectforeground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectforeground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.69 {configuration option: "state"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -state n + .e cget -state +} -cleanup { + destroy .e +} -result {normal} +test spinbox-1.70 {configuration option: "state" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -state bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad state "bogus": must be disabled, normal, or readonly} + +test spinbox-1.71 {configuration option: "takefocus"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -takefocus "any string" + .e cget -takefocus +} -cleanup { + destroy .e +} -result {any string} + +test spinbox-1.72 {configuration option: "textvariable"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -textvariable i + .e cget -textvariable +} -cleanup { + destroy .e +} -result {i} + +test spinbox-1.73 {configuration option: "to"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -to 14.9 + .e cget -to +} -cleanup { + destroy .e +} -result {14.9} +test spinbox-1.74 {configuration option: "to" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -to bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.75 {configuration option: "validate"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validate "key" + .e cget -validate +} -cleanup { + destroy .e +} -result {key} +test spinbox-1.76 {configuration option: "validate" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validate "bogus" +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} + +test spinbox-1.77 {configuration option: "validatecommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validatecommand "a command" + .e cget -validatecommand +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.78 {configuration option: "values"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -values {mon tue wed thur} + .e cget -values +} -cleanup { + destroy .e +} -result {mon tue wed thur} +test spinbox-1.79 {configuration option: "values" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -values {bad {}list} +} -cleanup { + destroy .e +} -returnCodes {error} -result {list element in braces followed by "list" instead of space} + +test spinbox-1.80 {configuration option: "vcmd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -vcmd "a command" + .e cget -vcmd +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.81 {configuration option: "width"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -width 402 + .e cget -width +} -cleanup { + destroy .e +} -result {402} +test spinbox-1.82 {configuration option: "width" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -width 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.83 {configuration option: "wrap"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -wrap yes + .e cget -wrap +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.84 {configuration option: "wrap" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -wrap xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test spinbox-1.85 {configuration option: "xscrollcommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -xscrollcommand {Some command} + .e cget -xscrollcommand +} -cleanup { + destroy .e +} -result {Some command} + + +test spinbox-2.1 {Tk_EntryCmd procedure} -body { + spinbox +} -returnCodes error -result {wrong # args: should be "spinbox pathName ?options?"} +test spinbox-2.2 {Tk_EntryCmd procedure} -body { + spinbox gorp +} -returnCodes error -result {bad window path name "gorp"} +test spinbox-2.3 {Tk_EntryCmd procedure} -body { spinbox .e + pack .e + update list [winfo exists .e] [winfo class .e] [info commands .e] -} {1 Spinbox .e} -test spinbox-2.4 {Tk_SpinboxCmd procedure} { - catch {destroy .e} - list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] \ - [info commands .e] -} {1 {unknown option "-gorp"} 0 {}} -test spinbox-2.5 {Tk_SpinboxCmd procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {1 Spinbox .e} +test spinbox-2.4 {Tk_EntryCmd procedure} -body { + spinbox .e -gorp foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test spinbox-2.5 {Tk_EntryCmd procedure} -body { + catch {spinbox .e -gorp foo} + list [winfo exists .e] [info commands .e] +} -cleanup { + destroy .e +} -result {0 {}} +test spinbox-2.6 {Tk_EntryCmd procedure} -body { spinbox .e -} {.e} - -catch {destroy .e} -spinbox .e -font $fixed -pack .e -update - -set cx [font measure $fixed a] -set cy [font metrics $fixed -linespace] -set ux [font measure $fixed \u4e4e] - -test spinbox-3.1 {SpinboxWidgetCmd procedure} { - list [catch {.e} msg] $msg -} {1 {wrong # args: should be ".e option ?arg arg ...?"}} -test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox a b} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox bogus} msg] $msg -} {1 {bad spinbox index "bogus"}} -test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end - .e bbox 0 -} [list 5 5 0 $cy] -test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no utf chars +} -cleanup { + destroy .e +} -result {.e} - .e delete 0 end + +test spinbox-3.1 {EntryWidgetCmd procedure} -setup { + spinbox .e + pack .e + update +} -body { + .e +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e option ?arg arg ...?"} +test spinbox-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test spinbox-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test spinbox-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e bbox bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bogus"} +test spinbox-3.5 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox 0 +} -cleanup { + destroy .e +} -result [list 5 5 0 $cy] + +# Oryginaly the result was count using measurements +# and metrics. It was changed to less verbose solution - the result is the one +# that passes fonts constraint (this concerns tests 3.6, 3.7, 3.8, 3.10) +test spinbox-3.6 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no utf chars .e insert 0 "abc" list [.e bbox 3] [.e bbox end] -} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] -test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf at end - .e delete 0 end +} -cleanup { + destroy .e +} -result {{19 5 7 13} {19 5 7 13}} +test spinbox-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf at end .e insert 0 "ab\u4e4e" .e bbox end -} "[expr 5+2*$cx] 5 $ux $cy" -test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf before index - .e delete 0 end +} -cleanup { + destroy .e +} -result {19 5 12 13} +test spinbox-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf before index .e insert 0 "ab\u4e4ec" .e bbox 3 -} "[expr 5+2*$cx+$ux] 5 $cx $cy" -test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no chars - .e delete 0 end +} -cleanup { + destroy .e +} -result {31 5 7 13} +test spinbox-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no chars .e bbox end -} "5 5 0 $cy" -test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result "5 5 0 $cy" +test spinbox-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { .e insert 0 "abcdefghij\u4e4eklmnop" list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] -} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] -test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget a b} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} { +} -cleanup { + destroy .e +} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}} +test spinbox-3.11 {EntryWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test spinbox-3.12 {EntryWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test spinbox-3.13 {EntryWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget -gorp +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test spinbox-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { .e configure -bd 4 .e cget -bd -} {4} -test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e + pack .e + update +} -body { llength [.e configure] -} {49} -test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} { - list [catch {.e configure -foo} msg] $msg -} {1 {unknown option "-foo"}} -test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {49} +test spinbox-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e +} -body { + .e configure -foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-foo"} +test spinbox-3.17 {EntryWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e +} -body { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 -} {4} -test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete a b c} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete 0 bar} msg] $msg -} {1 {bad spinbox index "bar"}} -test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.18 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test spinbox-3.19 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test spinbox-3.20 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.21 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete 0 bar +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bar"} +test spinbox-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 2 4 .e get -} {014567890} -test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {014567890} +test spinbox-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { .e insert end "01234567890" .e delete 6 .e get -} {0123457890} -test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { - # UTF +} -cleanup { + destroy .e +} -result {0123457890} +test spinbox-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update set x {} - .e delete 0 end +} -body { +# UTF .e insert end "01234\u4e4e67890" .e delete 6 lappend x [.e get] @@ -246,277 +1248,659 @@ test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { .e insert end "0123456\u4e4e890" .e delete 6 lappend x [.e get] -} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] -test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] +test spinbox-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 6 5 .e get -} {01234567890} -test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} { - list [catch {.e get foo} msg] $msg -} {1 {wrong # args: should be ".e get"}} -test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor} msg] $msg -} {1 {wrong # args: should be ".e icursor pos"}} -test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.27 {EntryWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "01234567890" + .e configure -state readonly + .e delete 2 8 + .e configure -state normal + .e get +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.28 {EntryWidgetCmd procedure, "get" widget command} -setup { + spinbox .e +} -body { + .e get foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e get"} +test spinbox-3.29 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { + .e icursor +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e icursor pos"} +test spinbox-3.30 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { + .e icursor foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.31 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { .e insert end "01234567890" .e icursor 4 .e index insert -} {4} -test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e in} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} -test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index} msg] $msg -} {1 {wrong # args: should be ".e index string"}} -test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index 0} msg] $msg -} {0 0} -test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} { - # UTF - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.32 {EntryWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e in +} -cleanup { + destroy .e +} -returnCodes error -result {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview} +test spinbox-3.33 {EntryWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e index +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e index string"} +test spinbox-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e index foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e index 0 +} -cleanup { + destroy .e +} -returnCodes {ok} -match glob -result {*} +test spinbox-3.36 {EntryWidgetCmd procedure, "index" widget command} -setup { + spinbox .e + pack .e + update +} -body { +# UTF .e insert 0 abc\u4e4e\u0153def list [.e index 3] [.e index 4] [.e index end] -} {3 4 8} -test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert foo Text} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 8} +test spinbox-3.37 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.38 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert foo Text +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e insert 3 xxx .e get -} {012xxx34567890} -test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {012xxx34567890} +test spinbox-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a b c} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan foobar 20} msg] $msg -} {1 {bad scan option "foobar": must be mark or dragto}} -test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan mark 20.1} msg] $msg -} {1 {expected integer but got "20.1"}} -# This test is non-portable because character sizes vary. +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.42 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "01234567890" + .e configure -state readonly + .e insert 3 xxx + .e configure -state normal + .e get +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.43 {EntryWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test spinbox-3.45 {EntryWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test spinbox-3.46 {EntryWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan foobar 20 +} -cleanup { + destroy .e +} -returnCodes error -result {bad scan option "foobar": must be mark or dragto} +test spinbox-3.47 {EntryWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan mark 20.1 +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "20.1"} -test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} {fonts} { - .e delete 0 end +# This test is non-portable because character sizes vary. +test spinbox-3.48 {EntryWidgetCmd procedure, "scan" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 + pack .e update +} -body { .e insert end "This is quite a long string, in fact a " .e insert end "very very long string" .e scan mark 30 .e scan dragto 28 .e index @0 -} {2} -test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} { - list [catch {.e select} msg] $msg -} {1 {wrong # args: should be ".e selection option ?index?"}} -test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} { - list [catch {.e select foo} msg] $msg -} {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}} -test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} { - list [catch {.e select clear gorp} msg] $msg -} {1 {wrong # args: should be ".e selection clear"}} -test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2} +test spinbox-3.49 {EntryWidgetCmd procedure, "select" widget command} -setup { + spinbox .e +} -body { + .e select +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection option ?index?"} +test spinbox-3.50 {EntryWidgetCmd procedure, "select" widget command} -setup { + spinbox .e +} -body { + .e select foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad selection option "foo": must be adjust, clear, element, from, present, range, or to} + +test spinbox-3.51 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e +} -body { + .e select clear gorp +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection clear"} +test spinbox-3.52 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 4 update .e select clear - list [catch {selection get} msg] $msg [selection own] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} -test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} { - list [catch {.e selection present foo} msg] $msg -} {1 {wrong # args: should be ".e selection present"}} -test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test spinbox-3.53 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 4 + update + .e select clear + catch {selection get} + selection own +} -cleanup { + destroy .e +} -result {.e} + +test spinbox-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e +} -body { + .e selection present foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection present"} +test spinbox-3.55 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present -} {1} -test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-3.56 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e configure -exportselection false .e selection present -} {1} -.e configure -exportselection true -test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-3.57 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e delete 0 end .e selection present -} {0} -test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust x} msg] $msg -} {1 {bad spinbox index "x"}} -test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection adjust index"}} -test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0} +test spinbox-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e +} -body { + .e select adjust x +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "x"} +test spinbox-3.59 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e +} -body { + .e select adjust 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection adjust index"} +test spinbox-3.60 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 4 selection get -} {123} -test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {123} +test spinbox-3.61 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 2 selection get -} {234} -test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} { - list [catch {.e select from 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection from index"}} -test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} { - list [catch {.e select range 2} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} { - list [catch {.e selection range 2 3 4} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {234} +test spinbox-3.62 {EntryWidgetCmd procedure, "selection from" widget command} -setup { + spinbox .e +} -body { + .e select from 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection from index"} + +test spinbox-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { + .e select range 2 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test spinbox-3.64 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { + .e selection range 2 3 4 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test spinbox-3.65 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { .e insert end 0123456789 .e select from 1 .e select to 5 .e select range 4 4 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-3.66 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 7 .e select range 2 9 list [.e index sel.first] [.e index sel.last] [.e index anchor] -} {2 9 3} -.e delete 0 end -.e insert end "This is quite a long text string, so long that it " -.e insert end "runs off the end of the window quite a bit." -test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} { - list [catch {.e select to 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection to index"}} -test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {2 9 3} +test spinbox-3.67 {EntryWidgetCmd procedure, "selection" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end 0123456789 + .e selection range 0 end + .e configure -state disabled + .e selection range 2 4 + .e configure -state normal + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {0 10} +test spinbox-3.68 {EntryWidgetCmd procedure, "selection" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end 0123456789 + .e selection range 0 end + .e configure -state readonly + .e selection range 2 4 + .e configure -state normal + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {2 4} +test spinbox-3.69 {EntryWidgetCmd procedure, "selection to" widget command} -setup { + spinbox .e + pack .e + update + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." +} -body { + .e select to 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection to index"} + +test spinbox-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 5 .e xview -} {0.0537634 0.268817} -test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview gorp} msg] $msg -} {1 {bad spinbox index "gorp"}} -test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.0537634 0.268817} +test spinbox-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "gorp"} +test spinbox-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 .e icursor 10 .e xview insert .e xview -} {0.107527 0.322581} -test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo bar} msg] $msg -} {1 {wrong # args: should be ".e xview moveto fraction"}} -test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo} msg] $msg -} {1 {expected floating-point number but got "foo"}} -test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.107527 0.322581} +test spinbox-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo bar +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} +test spinbox-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo +} -cleanup { + destroy .e +} -returnCodes error -result {expected floating-point number but got "foo"} +test spinbox-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto 0.5 .e xview -} {0.505376 0.72043} -test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 24} msg] $msg -} {1 {wrong # args: should be ".e xview scroll number units|pages"}} -test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll gorp units} msg] $msg -} {1 {expected integer but got "gorp"}} -test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.505376 0.72043} +test spinbox-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e xview scroll 24 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +test spinbox-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll gorp units +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "gorp"} +test spinbox-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview moveto 0 .e xview scroll 1 pages .e xview -} {0.193548 0.408602} -test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.193548 0.408602} +test spinbox-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto .9 update .e xview scroll -2 p .e xview -} {0.397849 0.612903} -test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.397849 0.612903} +test spinbox-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll 2 units .e index @0 -} {32} -test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {32} +test spinbox-3.81 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll -1 units .e index @0 -} {29} -test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 23 foobars} msg] $msg -} {1 {bad argument "foobars": must be units or pages}} -test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview eat 23 hamburgers} msg] $msg -} {1 {unknown option "eat": must be moveto or scroll}} -test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {29} +test spinbox-3.82 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll 23 foobars +} -cleanup { + destroy .e +} -returnCodes error -result {bad argument "foobars": must be units or pages} +test spinbox-3.83 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview eat 23 hamburgers +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "eat": must be moveto or scroll} +test spinbox-3.84 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 update .e xview -4 .e index @0 -} {0} -test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0} +test spinbox-3.85 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 300 .e index @0 -} {73} -.e insert 10 \u4e4e -test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { - # UTF - # If Tcl_NumUtfChars wasn't used, wrong answer would be: - # 0.106383 0.117021 0.117021 - +} -cleanup { + destroy .e +} -result {73} +test spinbox-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e insert 10 \u4e4e + update +# UTF +# If Tcl_NumUtfChars wasn't used, wrong answer would be: +# 0.106383 0.117021 0.117021 set x {} .e xview moveto .1 lappend x [lindex [.e xview] 0] @@ -524,221 +1908,327 @@ test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { lappend x [lindex [.e xview] 0] .e xview moveto .12 lappend x [lindex [.e xview] 0] -} {0.0957447 0.106383 0.117021} -test spinbox-3.82 {SpinboxWidgetCmd procedure} { - list [catch {.e gorp} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} - -frame .f -width 200 -height 50 -relief raised -bd 2 -pack .f -side right -test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {0.0957447 0.106383 0.117021} + +test spinbox-3.87 {EntryWidgetCmd procedure} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview} + +test spinbox-4.1 {ConfigureEntry procedure, -textvariable} -body { set x 12345 spinbox .e -textvariable x .e get -} {12345} -test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {12345} +test spinbox-4.1 {ConfigureEntry procedure, -textvariable} -body { set x 12345 spinbox .e -textvariable x set y abcde .e configure -textvariable y set x 54321 .e get -} {abcde} -test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} - catch {unset x} +} -cleanup { + destroy .e +} -result {abcde} +test spinbox-4.2 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x spinbox .e +} -body { .e insert 0 "Some text" .e configure -textvariable x - set x -} {Some text} -test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} { - proc override args { - global x - set x 12345 - } - catch {destroy .e} - catch {unset x} - trace variable x w override + return $x +} -cleanup { + destroy .e +} -result {Some text} +test spinbox-4.3 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x spinbox .e +} -body { + trace variable x w override .e insert 0 "Some text" .e configure -textvariable x - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} -test spinbox-5.5 {ConfigureSpinbox procedure} { - catch {destroy .e} - spinbox .e -exportselection false - pack .e - .e insert end "0123456789" - .sel select from 0 - .sel select to 10 + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override +} -result {12345 12345} + +test spinbox-4.4 {ConfigureEntry procedure} -setup { set x {} + spinbox .e1 + spinbox .e2 +} -body { + .e2 insert end "This is some sample text" + .e1 configure -exportselection false + .e1 insert end "0123456789" + pack .e1 .e2 + .e2 select from 0 + .e2 select to 10 lappend x [selection get] - .e select from 1 - .e select to 5 + .e1 select from 1 + .e1 select to 5 lappend x [selection get] - .e configure -exportselection 1 + .e1 configure -exportselection 1 lappend x [selection get] - set x -} {{This is so} {This is so} 1234} -test spinbox-5.6 {ConfigureSpinbox procedure} { - catch {destroy .e} + return $x +} -cleanup { + destroy .e1 .e2 +} -result {{This is so} {This is so} 1234} +test spinbox-4.5 {ConfigureEntry procedure} -setup { + spinbox .e + pack .e +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 5 + .e configure -exportselection 0 + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test spinbox-4.6 {ConfigureEntry procedure} -setup { spinbox .e pack .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 .e configure -exportselection 0 - list [catch {selection get} msg] $msg [.e index sel.first] \ - [.e index sel.last] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} -test spinbox-5.7 {ConfigureSpinbox procedure} { - catch {destroy .e} - spinbox .e -font $fixed -width 4 -xscrollcommand scroll + catch {selection get} + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 5} + +test spinbox-4.7 {ConfigureEntry procedure} -setup { + spinbox .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" update .e configure -width 5 - set scrollInfo -} {0 0.363636} -test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -width 0 + return $scrollInfo +} -cleanup { + destroy .e +} -result {0 0.363636} + +test spinbox-4.8 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -width 0 -font {Helvetica -12} .e insert end "0123" update - .e configure -font $big + .e configure -font {Helvetica -24} update winfo geom .e -} {79x37+0+0} -test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised +} -cleanup { + destroy .e +} -result {79x37+0+0} +test spinbox-4.9 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test spinbox-5.10 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief flat +} -cleanup { + destroy .e +} -result {0 0 1 1} +test spinbox-4.10 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test spinbox-5.11 {ConfigureSpinbox procedure} { - # If "0" in selected font had 0 width, caused divide-by-zero error. - - catch {destroy .e} - pack [spinbox .e -font {{open look glyph}}] +} -cleanup { + destroy .e +} -result {0 0 1 1} +test spinbox-4.11 {ConfigureEntry procedure} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 + pack .e +} -body { +# If "0" in selected font had 0 width, caused divide-by-zero error. + .e configure -font {{open look glyph}} .e scan dragto 30 update -} {} +} -cleanup { + destroy .e +} -result {} -# No tests for DisplaySpinbox. +# No tests for DisplayEntry. -test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 +test spinbox-5.1 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -highlightthickness 3 .e insert end 012\t45 update list [.e index @61] [.e index @62] -} {3 4} -test spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-5.2 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify center \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @96] [.e index @97] -} {3 4} -test spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-5.3 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify right \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @131] [.e index @132] -} {3 4} -test spinbox-6.4 {SpinboxComputeGeometry procedure} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-5.4 {EntryComputeGeometry procedure} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 .e index @0 -} {6} -test spinbox-6.5 {SpinboxComputeGeometry procedure} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {6} +test spinbox-5.5 {EntryComputeGeometry procedure} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 .e index @0 -} {6} -test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 10 +} -cleanup { + destroy .e +} -result {6} +test spinbox-5.6 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 list [.e index @39] [.e index @40] -} {5 6} -test spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {5 6} +test spinbox-5.7 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {94 39} -test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 0 +} -cleanup { + destroy .e +} -result {94 39} +test spinbox-5.8 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {133 39} -test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 +} -cleanup { + destroy .e +} -result {133 39} +test spinbox-5.9 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] -} {42 39} +} -cleanup { + destroy .e +} -result {42 39} -catch {destroy .e} -spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll -pack .e -focus .e -test spinbox-7.1 {InsertChars procedure} { - .e delete 0 end + +test spinbox-6.1 {InsertChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 2 XXX update list [.e get] $contents $scrollInfo -} {abXXXcde abXXXcde {0 1}} -test spinbox-7.2 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abXXXcde abXXXcde {0 1}} + +test spinbox-6.2 {InsertChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 500 XXX update list [.e get] $contents $scrollInfo -} {abcdeXXX abcdeXXX {0 1}} -test spinbox-7.3 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abcdeXXX abcdeXXX {0 1}} +test spinbox-6.3 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -746,9 +2236,13 @@ test spinbox-7.3 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {5 9 5 8} -test spinbox-7.4 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {5 9 5 8} +test spinbox-6.4 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -756,9 +2250,13 @@ test spinbox-7.4 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test spinbox-7.5 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test spinbox-6.5 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -766,9 +2264,13 @@ test spinbox-7.5 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test spinbox-7.6 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test spinbox-6.6 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -776,70 +2278,118 @@ test spinbox-7.6 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {2 6 2 5} -test spinbox-7.7 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 6 2 5} +test spinbox-6.7 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -xscrollcommand scroll .e insert 0 0123456789 .e icursor 4 .e insert 4 XXX .e index insert -} {7} -test spinbox-7.8 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test spinbox-6.8 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e icursor 4 .e insert 5 XXX .e index insert -} {4} -test spinbox-7.9 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-6.9 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 3 XXX .e index @0 -} {7} -test spinbox-7.10 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test spinbox-6.10 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 4 XXX .e index @0 -} {4} -.e configure -width 0 -test spinbox-7.11 {InsertChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} + +test spinbox-6.11 {InsertChars procedure} -constraints { + fonts +} -setup { + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "xyzzy" update .e insert 2 00 winfo reqwidth .e -} {70} +} -cleanup { + destroy .e +} -result {70} -.e configure -width 10 -test spinbox-8.1 {DeleteChars procedure} { - .e delete 0 end +test spinbox-7.1 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 2 4 update list [.e get] $contents $scrollInfo -} {abe abe {0 1}} -test spinbox-8.2 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abe abe {0 1}} +test spinbox-7.2 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete -2 2 update list [.e get] $contents $scrollInfo -} {cde cde {0 1}} -test spinbox-8.3 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {cde cde {0 1}} +test spinbox-7.3 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 3 1000 update list [.e get] $contents $scrollInfo -} {abc abc {0 1}} -test spinbox-8.4 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abc abc {0 1}} +test spinbox-7.4 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -848,9 +2398,14 @@ test spinbox-8.4 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 6 1 5} -test spinbox-8.5 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 6 1 5} +test spinbox-7.5 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -859,9 +2414,14 @@ test spinbox-8.5 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {1 5 1 4} -test spinbox-8.6 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 5 1 4} +test spinbox-7.6 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -870,17 +2430,28 @@ test spinbox-8.6 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 2 1 5} -test spinbox-8.7 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 2 1 5} +test spinbox-7.7 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-8.8 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-7.8 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -889,17 +2460,27 @@ test spinbox-8.8 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 4 3 8} -test spinbox-8.9 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 3 8} +test spinbox-7.9 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-8.10 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-7.10 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -908,9 +2489,14 @@ test spinbox-8.10 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 5 5 8} -test spinbox-8.11 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 5 5 8} +test spinbox-7.11 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -919,124 +2505,185 @@ test spinbox-8.11 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {3 8 4 8} -test spinbox-8.12 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 8 4 8} +test spinbox-7.12 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 4 + update .e index insert -} {1} -test spinbox-8.13 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-7.13 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 5 + update .e index insert -} {1} -test spinbox-8.14 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-7.14 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 4 6 + update .e index insert -} {4} -test spinbox-8.15 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-7.15 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 4 + update .e index @0 -} {1} -test spinbox-8.16 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-7.16 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 5 + update .e index @0 -} {1} -test spinbox-8.17 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-7.17 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 4 6 + update .e index @0 -} {4} -.e configure -width 0 -test spinbox-8.18 {DeleteChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-7.18 {DeleteChars procedure} -setup { + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "xyzzy" update .e delete 2 4 winfo reqwidth .e -} {42} +} -cleanup { + destroy .e +} -result {42} -test spinbox-9.1 {SpinboxValueChanged procedure} { - catch {destroy .e} - proc override args { - global x - set x 12345 - } - catch {unset x} +test spinbox-8.1 {EntryValueChanged procedure} -setup { + unset -nocomplain x +} -body { trace variable x w override - spinbox .e -textvariable x + spinbox .e -textvariable x -width 0 .e insert 0 foo - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} - -catch {destroy .e} -spinbox .e -pack .e -.e configure -width 0 -test spinbox-10.1 {SpinboxSetValue procedure} {fonts} { + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override +} -result {12345 12345} + + +test spinbox-9.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab - .e configure -textvariable x - update + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + pack .e + .e configure -textvariable x .e configure -textvariable y update list [.e get] [winfo reqwidth .e] -} {ab 35} -test spinbox-10.2 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x +} -cleanup { + destroy .e +} -result {ab 35} +test spinbox-9.2 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "a" - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-10.3 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-9.3 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefg" list [.e index sel.first] [.e index sel.last] -} {4 7} -test spinbox-10.4 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x +} -cleanup { + destroy .e +} -result {4 7} +test spinbox-9.4 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefghijklmn" list [.e index sel.first] [.e index sel.last] -} {4 10} -test spinbox-10.5 {SpinboxSetValue procedure, updating display position} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {4 10} +test spinbox-9.5 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "abcdefg" update .e index @0 -} {0} -test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {0} +test spinbox-9.6 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 @@ -1044,177 +2691,440 @@ test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { set x "1234567890123456789012" update .e index @0 -} {10} -test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {10} +test spinbox-9.7 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e + update +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" .e index insert -} {3} -test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {3} +test spinbox-9.8 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" .e index insert -} {5} +} -cleanup { + destroy .e +} -result {5} -test spinbox-11.1 {SpinboxEventProc procedure} { - catch {destroy .e} - spinbox .e +test spinbox-10.1 {EntryEventProc procedure} -setup { + spinbox .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + pack .e +} -body { .e insert 0 abcdefg destroy .e update -} {} -test spinbox-11.2 {SpinboxEventProc procedure} { - deleteWindows +} -cleanup { + destroy .e +} -result {} +test spinbox-10.2 {EntryEventProc procedure} -setup { + set x {} +} -body { spinbox .e1 -fg #112233 rename .e1 .e2 - set x {} lappend x [winfo children .] lappend x [.e2 cget -fg] destroy .e1 lappend x [info command .e*] [winfo children .] -} {.e1 #112233 {} {}} - -test spinbox-12.1 {SpinboxCmdDeletedProc procedure} { - deleteWindows - button .e1 -text "xyz_123" - rename .e1 {} - list [info command .e*] [winfo children .] -} {{} {}} - -catch {destroy .e} -spinbox .e -font $fixed -width 5 -bd 2 -relief sunken -pack .e -.e insert 0 012345678901234567890 -.e xview 4 -update -test spinbox-13.1 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e1 +} -result {.e1 #112233 {} {}} + +test spinbox-11.1 {EntryCmdDeletedProc procedure} -body { + button .b -text "xyz_123" + rename .b {} + list [info command .b*] [winfo children .] +} -cleanup { + destroy .b +} -result {{} {}} + + +test spinbox-12.1 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e index end -} {21} -test spinbox-13.2 {GetSpinboxIndex procedure} { - list [catch {.e index abogus} msg] $msg -} {1 {bad spinbox index "abogus"}} -test spinbox-13.3 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {21} +test spinbox-12.2 {GetEntryIndex procedure} -body { + spinbox .e + .e index abogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "abogus"} +test spinbox-12.3 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 .e index anchor -} {1} -test spinbox-13.4 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {1} +test spinbox-12.4 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 4 .e select to 1 .e index anchor -} {4} -test spinbox-13.5 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-12.5 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 3 .e select to 15 .e select adjust 4 .e index anchor -} {15} -test spinbox-13.6 {GetSpinboxIndex procedure} { - list [catch {.e index ebogus} msg] $msg -} {1 {bad spinbox index "ebogus"}} -test spinbox-13.7 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {15} +test spinbox-12.6 {GetEntryIndex procedure} -setup { + spinbox .e +} -body { + .e index ebogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "ebogus"} +test spinbox-12.7 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e icursor 2 .e index insert -} {2} -test spinbox-13.8 {GetSpinboxIndex procedure} { - list [catch {.e index ibogus} msg] $msg -} {1 {bad spinbox index "ibogus"}} -test spinbox-13.9 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {2} +test spinbox-12.8 {GetEntryIndex procedure} -setup { + spinbox .e +} -body { + .e index ibogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "ibogus"} +test spinbox-12.9 {GetEntryIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 6} + +test spinbox-12.10 {GetEntryIndex procedure} -constraints unix -body { +# On unix, when selection is cleared, spinbox widget's internal +# selection range is reset. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-12.11 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +test spinbox-12.12 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 list [.e index sel.first] [.e index sel.last] -} {1 6} -selection clear .e -test spinbox-13.10 {GetSpinboxIndex procedure} unix { - # On unix, when selection is cleared, spinbox widget's internal - # selection range is reset. - - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-13.11 {GetSpinboxIndex procedure} win { - # On mac and pc, when selection is cleared, spinbox widget remembers - # last selected range. When selection ownership is restored to - # spinbox, the old range will be rehighlighted. - - list [catch {selection get}] [.e index sel.first] -} {1 1} -test spinbox-13.12 {GetSpinboxIndex procedure} unix { - list [catch {.e index sbogus} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-13.13 {GetSpinboxIndex procedure} win { - list [catch {.e index sbogus} msg] $msg -} {1 {bad spinbox index "sbogus"}} -test spinbox-13.14 {GetSpinboxIndex procedure} win { - list [catch {selection get}] [catch {.e index sbogus}] -} {1 1} -test spinbox-13.15 {GetSpinboxIndex procedure} { - list [catch {.e index @xyz} msg] $msg -} {1 {bad spinbox index "@xyz"}} -test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} { +# Testing: + selection clear .e + .e index bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bogus"} + +test spinbox-12.13 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + selection get +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} +test spinbox-12.14 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sel.first +} -cleanup { + destroy .e +} -result {1} +test spinbox-12.15 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} +test spinbox-12.16 {GetEntryIndex procedure} -constraints win -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "sbogus"} + +test spinbox-12.17 {GetEntryIndex procedure} -body { + spinbox .e + selection clear .e + .e index @xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "@xyz"} + +test spinbox-12.18 {GetEntryIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @4 -} {4} -test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-12.19 {GetEntryIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @11 -} {4} -test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-12.20 {GetEntryIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @12 -} {5} -test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} { - # 11 is the minimum button width - .e index @[expr [winfo width .e] - 6 - 11] -} {8} -test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 5] -} {9} -test spinbox-13.21 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {5} +test spinbox-12.21 {GetEntryIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 6-11}] +} -cleanup { + destroy .e +} -result {8} +test spinbox-12.22 {GetEntryIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 5}] +} -cleanup { + destroy .e +} -result {9} +test spinbox-12.23 {GetEntryIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @1000 -} {9} -test spinbox-13.22 {GetSpinboxIndex procedure} { - list [catch {.e index 1xyz} msg] $msg -} {1 {bad spinbox index "1xyz"}} -test spinbox-13.23 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {9} +test spinbox-12.24 {GetEntryIndex procedure} -setup { + spinbox .e + pack .e + update +} -body { + .e index 1xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "1xyz"} +test spinbox-12.25 {GetEntryIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index -10 -} {0} -test spinbox-13.24 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {0} +test spinbox-12.26 {GetEntryIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 12 -} {12} -test spinbox-13.25 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {12} +test spinbox-12.27 {GetEntryIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 49 -} {21} +} -cleanup { + destroy .e +} -result {21} -# XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. +# XXX Still need to write tests for EntryScanTo and EntrySelectTo. -set x {} -for {set i 1} {$i <= 500} {incr i} { - append x "This is line $i, out of 500\n" -} -test spinbox-14.1 {SpinboxFetchSelection procedure} { - catch {destroy .e} +test spinbox-13.1 {EntryFetchSelection procedure} -body { spinbox .e .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {his is a test str} -test spinbox-14.3 {SpinboxFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {his is a test str} +test spinbox-13.2 {EntryFetchSelection procedure} -setup { + set x {} + for {set i 1} {$i <= 500} {incr i} { + append x "This is line $i, out of 500\n" +} +} -body { spinbox .e - .e insert end $x + .e insert end $x .e select from 0 .e select to end string compare [selection get] $x -} 0 +} -cleanup { + destroy .e +} -result {0} -test spinbox-15.1 {SpinboxLostSelection} { - catch {destroy .e} +test spinbox-14.1 {EntryLostSelection} -body { spinbox .e .e insert 0 "Text" .e select from 0 @@ -1224,265 +3134,546 @@ test spinbox-15.1 {SpinboxLostSelection} { .e select from 0 .e select to 4 lappend result [selection get] -} {Text Text} - -# No tests for EventuallyRedraw. +} -cleanup { + destroy .e +} -result {Text Text} -catch {destroy .e} -spinbox .e -width 10 -xscrollcommand scroll -pack .e -update -test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} { - .e delete 0 end - .e insert 0 ............................. +test spinbox-15.1 {EntryVisibleRange procedure} -constraints fonts -body { + spinbox .e -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." .e xview -} {0 0.827586} -test spinbox-15.4 {SpinboxVisibleRange procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0 0.827586} +test spinbox-16.2 {EntryVisibleRange procedure} -body { + spinbox .e .e xview -} {0 1} +} -cleanup { + destroy .e +} -result {0 1} -catch {destroy .e} -spinbox .e -width 10 -xscrollcommand scroll -font $fixed -pack .e -update -test spinbox-17.1 {SpinboxUpdateScrollbar procedure} { + +test spinbox-16.1 {EntryUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e delete 0 end .e insert 0 123 update - set scrollInfo -} {0 1} -test spinbox-17.2 {SpinboxUpdateScrollbar procedure} { - .e delete 0 end + return $scrollInfo +} -cleanup { + destroy .e +} -result {0 1} +test spinbox-16.2 {EntryUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 0123456789abcdef .e xview 3 update - set scrollInfo -} {0.1875 0.8125} -test spinbox-17.3 {SpinboxUpdateScrollbar procedure} { - .e delete 0 end + return $scrollInfo +} -cleanup { + destroy .e +} -result {0.1875 0.8125} +test spinbox-16.3 {EntryUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 abcdefghijklmnopqrs .e xview 6 update - set scrollInfo -} {0.315789 0.842105} -test spinbox-17.4 {SpinboxUpdateScrollbar procedure} { + return $scrollInfo +} -cleanup { destroy .e - set x "Background error did not happen" +} -result {0.315789 0.842105} +test spinbox-16.4 {EntryUpdateScrollbar procedure} -setup { proc bgerror msg { global x set x $msg - } +} +} -body { spinbox .e -width 5 -xscrollcommand thisisnotacommand pack .e update - rename bgerror {} list $x $errorInfo -} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" +} -cleanup { + destroy .e + rename bgerror {} +} -result {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0 1" (horizontal scrolling command executed by .e)}} -set l [interp hidden] -deleteWindows -test spinbox-18.1 {Spinbox widget vs hiding} { - destroy .e +test spinbox-17.1 {Entry widget vs hiding} -setup { spinbox .e +} -body { + set l [interp hidden] interp hide {} .e destroy .e - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -result {1} ## -## Spinbox widget VALIDATION tests +## Entry widget VALIDATION tests ## - -destroy .e -catch {unset ::e} -catch {unset ::vVals} -spinbox .e -validate all \ - -validatecommand [list doval %W %d %i %P %s %S %v %V] \ - -invalidcommand bell \ - -textvariable ::e \ - -background red -foreground white -pack .e -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 1 -} - # The validation tests build each one upon the previous, so cascading # failures aren't good # -test spinbox-19.1 {spinbox widget validation} { +# 18.* test cases in previous version highly depended on the previous +# test cases. This was replaced by inserting recently set configurations +# that matters for the test case +test spinbox-18.1 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e .e insert 0 a - set ::vVals -} {.e 1 0 a {} a all key} -test spinbox-19.2 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 0 a {} a all key} + +test spinbox-18.2 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a ;# previous settings .e insert 1 b - set ::vVals -} {.e 1 1 ab a b all key} -test spinbox-19.3 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 1 ab a b all key} + +test spinbox-18.3 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 ab ;# previous settings .e insert end c - set ::vVals -} {.e 1 2 abc ab c all key} -test spinbox-19.4 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 2 abc ab c all key} + +test spinbox-18.4 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e -} {{.e 1 1 a123bc abc 123 all key} a123bc} -test spinbox-19.5 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {{.e 1 1 a123bc abc 123 all key} a123bc} + +test spinbox-18.5 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a123bc ;# previous settings .e delete 2 - set ::vVals -} {.e 0 2 a13bc a123bc 2 all key} -test spinbox-19.6 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 2 a13bc a123bc 2 all key} + +test spinbox-18.6 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 - set ::vVals -} {.e 0 1 abc a13bc 13 key key} -test spinbox-19.7 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 1 abc a13bc 13 key key} + +test spinbox-18.7 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abc ;# previous settings set ::vVals {} - .e configure -validate focus .e insert end d - set ::vVals -} {} -test spinbox-19.8 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test spinbox-18.8 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e configure -validate focus ;# previous settings + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusin} -test spinbox-19.9 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusin} + +test spinbox-18.9 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings + update ;# previous settings +# update necessary to process FocusIn event focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusout} -.e configure -validate all -test spinbox-19.10 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusout} + +test spinbox-18.10 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusin} -test spinbox-19.11 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusin} + +test spinbox-18.11 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusout} -.e configure -validate focusin -test spinbox-19.12 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusout} + +test spinbox-18.12 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusin focusin} -test spinbox-19.13 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusin focusin} + +test spinbox-18.13 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::vVals {} focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {} -.e configure -validate focuso -test spinbox-19.14 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test spinbox-18.14 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {} -test spinbox-19.15 {spinbox widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test spinbox-18.15 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event + update + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusout focusout} + +# the same as 19.16 but added [.e validate] to returned list +test spinbox-18.16 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings + focus -force . +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusout focusout} -test spinbox-19.16 {spinbox widget validation} { list [.e validate] $::vVals -} {1 {.e -1 -1 abcd abcd {} all forced}} -test spinbox-19.17 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {1 {.e -1 -1 abcd abcd {} all forced}} + + +test spinbox-18.17 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals -} {focusout {.e -1 -1 newdata abcd {} focusout forced}} +} -cleanup { + destroy .e +} -result {focusout {.e -1 -1 newdata abcd {} focusout forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 0 -} -.e configure -validate all -test spinbox-19.18 {spinbox widget validation} { +# proc doval changed - returns 0 +test spinbox-18.18 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e newdata ;# previous settings + .e configure -validate all set ::e nextdata list [.e cget -validate] $::vVals -} {none {.e -1 -1 nextdata newdata {} all forced}} +} -cleanup { + destroy .e +} -result {none {.e -1 -1 nextdata newdata {} all forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - set ::e mydata - return 1 -} -.e configure -validate all ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the spinbox textvar is also set -test spinbox-19.19 {spinbox widget validation} { +# proc doval2 used +test spinbox-18.19 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] .e validate list [.e cget -validate] [.e get] $::vVals -} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} - -.e configure -validate all +} -cleanup { + destroy .e +} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the spinbox widget shown as is in the textvar. -test spinbox-19.20 {spinbox widget validation} { +test spinbox-18.20 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev + .e validate ;# previous settings + + .e configure -validate all set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals -} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} +} -cleanup { + destroy .e +} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} +## +## End validation tests +## -# A format specifier is allowed to be of the form %[-+ 0]{0,1}\d.?\d?f -# -destroy .e -spinbox .e -test spinbox-20.1 {spinbox config, -format specifier} { - list [catch {.e config -format %2f} msg] $msg -} {0 {}} -test spinbox-20.2 {spinbox config, -format specifier} { - list [catch {.e config -format %2.2f} msg] $msg -} {0 {}} -test spinbox-20.3 {spinbox config, -format specifier} { - list [catch {.e config -format %.2f} msg] $msg -} {0 {}} -test spinbox-20.4 {spinbox config, -format specifier} { - list [catch {.e config -format %2.f} msg] $msg -} {0 {}} -test spinbox-20.5 {spinbox config, -format specifier} { - list [catch {.e config -format %2e-1f} msg] $msg -} {1 {bad spinbox format specifier "%2e-1f"}} -test spinbox-20.6 {spinbox config, -format specifier} { - list [catch {.e config -format 2.2} msg] $msg -} {1 {bad spinbox format specifier "2.2"}} -test spinbox-20.7 {spinbox config, -format specifier} { - list [catch {.e config -format %2.-2f} msg] $msg -} {1 {bad spinbox format specifier "%2.-2f"}} -test spinbox-20.8 {spinbox config, -format specifier} { - list [catch {.e config -format %-2.02f} msg] $msg -} {0 {}} -test spinbox-20.9 {spinbox config, -format specifier} { - list [catch {.e config -format "% 2.02f"} msg] $msg -} {0 {}} -test spinbox-20.10 {spinbox config, -format specifier} { - list [catch {.e config -format "% -2.200f"} msg] $msg -} {0 {}} -test spinbox-20.11 {spinbox config, -format specifier} { - list [catch {.e config -format "%09.200f"} msg] $msg -} {0 {}} -test spinbox-20.12 {spinbox config, -format specifier does something} { +test spinbox-19.1 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.2 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.3 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %.2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.4 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.5 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2e-1f +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%2e-1f"} +test spinbox-19.6 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format 2.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "2.2"} +test spinbox-19.7 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.-2f +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%2.-2f"} +test spinbox-19.8 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %-2.02f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.9 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "% 2.02f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.10 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "% -2.200f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.11 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "%09.200f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-19.12 {spinbox config, -format specifier does something} -setup { + spinbox .e set out {} +} -body { .e config -format "%02.f" .e config -values {} -from 0 -to 10 -increment 1 lappend out [.e set 0]; # set currently doesn't force format @@ -1491,10 +3682,12 @@ test spinbox-20.12 {spinbox config, -format specifier does something} { lappend out [.e set 3]; # set currently doesn't force format .e config -format "%03.f" lappend out [.e set]; # changing -format should cause formatting -} {0 01 3 003} - -test spinbox-21.1 {spinbox button, out of range checking} { +} -cleanup { destroy .e +} -result {0 01 3 003} + + +test spinbox-20.1 {spinbox button, out of range checking} -body { spinbox .e -from -10 -to 20 -increment 2 set out {} lappend out [.e get]; # -10 @@ -1552,50 +3745,60 @@ test spinbox-21.1 {spinbox button, out of range checking} { lappend out [.e get]; # 18 .e invoke buttonup; # no wrap lappend out [.e get]; # 20 +} -cleanup { + destroy .e +} -result {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} -} {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} - -test spinbox-22.1 {spinbox config, -from changes SF bug 559078} { +test spinbox-21.1 {spinbox config, -from changes SF bug 559078} -body { set val 5 - destroy .s - spinbox .s -from 1 -to 10 -textvariable val - set val -} {5} -test spinbox-22.2 {spinbox config, -from changes SF bug 559078} { - .s configure -from 3 -to 10 - set val -} {5} -test spinbox-22.3 {spinbox config, -from changes SF bug 559078} { - .s configure -from 6 -to 10 - set val -} {6} - -test entry-23.1 {selection present while disabled, bug 637828} { - destroy .e - entry .e + spinbox .e -from 1 -to 10 -textvariable val + return $val +} -cleanup { + destroy .e +} -result {5} +test spinbox-21.2 {spinbox config, -from changes SF bug 559078} -body { + set val 5 + spinbox .e -from 1 -to 10 -textvariable val + .e configure -from 3 -to 10 + return $val +} -cleanup { + destroy .e +} -result {5} +test spinbox-21.3 {spinbox config, -from changes SF bug 559078} -body { + set val 5 + spinbox .e -from 3 -to 10 -textvariable val + .e configure -from 6 -to 10 + return $val +} -cleanup { + destroy .e +} -result {6} + +test spinbox-22.1 {selection present while disabled, bug 637828} -body { + spinbox .e .e insert end 0123456789 .e select from 3 .e select to 6 set out [.e selection present] .e configure -state disabled - # still return 1 when disabled, because 'selection get' will work, - # but selection cannot be changed (new behavior since 8.4) +# still return 1 when disabled, because 'selection get' will work, +# but selection cannot be changed (new behavior since 8.4) .e select to 9 lappend out [.e selection present] [selection get] -} {1 1 345} - -destroy .e -catch {unset ::e ::vVals} - -## -## End validation tests -## +} -cleanup { + destroy .e +} -result {1 1 345} -# XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, -# and SpinboxTextVarProc. -option clear +# Collected comments about lacks from the test +# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, +# and EntryTextVarProc. +# No tests for DisplayEntry. +# XXX Still need to write tests for EntryScanTo and EntrySelectTo. +# No tests for EventuallyRedraw +# option clear # cleanup cleanupTests return + + |