summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:28:21 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:28:21 (GMT)
commit83c5ef89d9d718ed6d0d73b462e5e151c34533ef (patch)
tree1ce7efd2a5eb0c65d8061dbd5f2ff9bc801e63d4 /tests
parentb0f648ca07ee75943d80ed107f90e99616870a35 (diff)
downloadtk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.zip
tk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.tar.gz
tk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.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 ae2803e..13c1d3a 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.13 2003/04/01 21:06:50 dgp Exp $
+# RCS: @(#) $Id: scale.test,v 1.14 2003/08/13 10:28:21 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -814,6 +814,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