summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:59:33 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:59:33 (GMT)
commit3b3c9c1c3c7745de0f2de35cd4a3a1f4fc109c78 (patch)
tree6bdd9a994852d1634a94185de1f641b67def97b6 /tests
parent325d3bf1d60abe5c222b729356c0e6424718ad59 (diff)
downloadtk-3b3c9c1c3c7745de0f2de35cd4a3a1f4fc109c78.zip
tk-3b3c9c1c3c7745de0f2de35cd4a3a1f4fc109c78.tar.gz
tk-3b3c9c1c3c7745de0f2de35cd4a3a1f4fc109c78.tar.bz2
* library/scale.tcl: Fix for bug #787065 for Button-2 press.
* tests/scale.test: Added test for this bug.
Diffstat (limited to 'tests')
-rw-r--r--tests/scale.test52
1 files changed, 51 insertions, 1 deletions
diff --git a/tests/scale.test b/tests/scale.test
index fb9ba5d..396ed76 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scale.test,v 1.12 2002/07/13 20:28:35 dgp Exp $
+# RCS: @(#) $Id: scale.test,v 1.12.2.1 2003/08/13 10:59:33 patthoyts Exp $
package require tcltest 2.1
namespace import -force tcltest::configure
@@ -817,6 +817,56 @@ test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
destroy .s
} {}
+test scale-18.2 {Scale button 1 events [Bug 787065]} \
+ -setup {
+ catch {destroy .s}
+ set y 5
+ scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+ pack .s
+ tkwait visibility .s
+ set ::error {}
+ proc bgerror {args} {set ::error $args}
+ } \
+ -body {
+ list [catch {
+ event generate .s <1> -x 0 -y 0
+ event generate .s <ButtonRelease-1> -x 0 -y 0
+ update
+ set ::error
+ } msg] $msg
+ } \
+ -cleanup {
+ unset ::error
+ rename bgerror {}
+ catch {destroy .s}
+ } \
+ -result {0 {}}
+
+test scale-18.3 {Scale button 2 events [Bug 787065]} \
+ -setup {
+ catch {destroy .s}
+ set y 5
+ scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+ pack .s
+ tkwait visibility .s
+ set ::error {}
+ proc bgerror {args} {set ::error $args}
+ } \
+ -body {
+ list [catch {
+ event generate .s <2> -x 0 -y 0
+ event generate .s <ButtonRelease-2> -x 0 -y 0
+ update
+ set ::error
+ } msg] $msg
+ } \
+ -cleanup {
+ unset ::error
+ rename bgerror {}
+ catch {destroy .s}
+ } \
+ -result {0 {}}
+
catch {destroy .s}
option clear