Initial revision

1 files changed, 154 insertions, 0 deletions

diff --git a/tests/winButton.test b/tests/winButton.test
new file mode 100644
index 0000000..7125aa5
--- /dev/null
+++ b/tests/winButton.test
@@ -0,0 +1,154 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
+# widgets defined in tkWinButton.c).  It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) winButton.test 1.3 97/07/01 18:11:44
+
+if {$tcl_platform(platform)!="windows"} {
+    return
+}
+
+if {[lsearch [image types] test] < 0} {
+    puts "This application hasn't been compiled with the \"test\""
+    puts "image, so I can't run this test.  Are you sure you're using"
+    puts "tktest instead of wish?"
+    return
+}
+
+if {[info procs test] != "test"} {
+    source defs
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+proc bogusTrace args {
+    error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+eval image delete [image names]
+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
+
+test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    image create test image1
+    image1 changed 0 0 0 0 60 40
+    label .b1 -image image1 -bd 4 -padx 0 -pady 2
+    button .b2 -image image1 -bd 4 -padx 0 -pady 2
+    checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1
+    radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {68 48 71 51 96 50 96 50}
+test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    label .b1 -bitmap question -bd 3 -padx 0 -pady 2
+    button .b2 -bitmap question -bd 3 -padx 0 -pady 2
+    checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
+    radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {23 33 26 36 51 35 51 35}
+test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    label .b1 -bitmap question -bd 3 -highlightthickness 4
+    button .b2 -bitmap question -bd 3 -highlightthickness 0
+    checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
+	    -indicatoron 0
+    radiobutton .b4 -bitmap question -bd 3 -indicatoron false
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {31 41 24 34 26 36 26 36}
+test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
+    eval destroy [winfo children .]
+    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
+    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
+    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8}
+    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8}
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {45 21 54 30 74 27 76 25} 
+test winbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable} {
+    eval destroy [winfo children .]
+    label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
+    pack .l1
+    update
+    list [winfo reqwidth .l1] [winfo reqheight .l1]
+} {142 69}
+test winbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable} {
+    eval destroy [winfo children .]
+    label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
+    pack .l1
+    update
+    list [winfo reqwidth .l1] [winfo reqheight .l1]
+} {180 43}
+test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
+    eval destroy [winfo children .]
+    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
+    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
+    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
+    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {64 21 54 82 153 40 59 25}
+test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
+    eval destroy [winfo children .]
+    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
+	-highlightthickness 4
+    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
+	-highlightthickness 0
+    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1  \
+	-highlightthickness 1 -indicatoron no
+    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
+    pack .b1 .b2 .b3 .b4
+    update
+    list [winfo reqwidth .b1] [winfo reqheight .b1] \
+	    [winfo reqwidth .b2] [winfo reqheight .b2] \
+	    [winfo reqwidth .b3] [winfo reqheight .b3] \
+	    [winfo reqwidth .b4] [winfo reqheight .b4]
+} {53 29 52 28 56 28 58 26}
+test winbutton-1.9 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    button .b2 -bitmap question -default normal
+    list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {24 34}
+
+eval destroy [winfo children .]