summaryrefslogtreecommitdiffstats
path: root/tests/scale.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/scale.test')
-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