Fixed bug [2262543] - Scale widget unexpectedly fires command callback

2 files changed, 122 insertions, 1 deletions

diff --git a/generic/tkScale.c b/generic/tkScale.c
index cc7c294..cbc5202 100644
--- a/generic/tkScale.c
+++ b/generic/tkScale.c
@@ -303,6 +303,12 @@ Tk_ScaleObjCmd(
 	return TCL_ERROR;
     }
 
+    /*
+     * The widget was just created, no command callback must be invoked.
+     */
+
+    scalePtr->flags &= ~INVOKE_COMMAND;
+
     Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin));
     return TCL_OK;
 }
@@ -1268,7 +1274,14 @@ TkScaleSetValue(
 	return;
     }
     scalePtr->value = value;
-    if (invokeCommand) {
+
+    /*
+     * Schedule command callback invocation only if there is such a command
+     * already registered, otherwise the callback would trigger later when
+     * configuring the widget -command option even if the value did not change.
+     */
+
+    if ((invokeCommand) && (scalePtr->command != NULL)) {
 	scalePtr->flags |= INVOKE_COMMAND;
     }
     TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
diff --git a/tests/scale.test b/tests/scale.test
index a8d08a8..8c14ed4 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1396,6 +1396,114 @@ test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \
     } \
     -result {1.0 1.0 1.0 1.0}
 
+test scale-20.1 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 1} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50 -command {set commandedVar}
+    pack .s
+    update  ; # -command callback shall NOT fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {1 -1}
+test scale-20.2 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 2} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+    set scaleVar 7
+} -body {
+    scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
+    pack .s
+    update  ; # -command callback shall NOT fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {7 -1}
+test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 3} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50
+    .s set 10
+    .s configure -command {set commandedVar}
+    pack .s
+    update  ; # -command callback shall NOT fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 -1}
+test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50 -command {set commandedVar}
+    .s set 10
+    pack .s
+    update  ; # -command callback shall fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 10}
+test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50
+    pack .s
+    .s set 10
+    .s configure -command {set commandedVar}
+    update  ; # -command callback shall NOT fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 -1}
+test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 6} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50
+    pack .s
+    .s configure -command {set commandedVar}
+    .s set 10
+    update  ; # -command callback shall fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 10}
+test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 7} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+} -body {
+    scale .s -from 1 -to 50 -command {set commandedVar}
+    pack .s
+    .s set 10
+    update  ; # -command callback shall fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 10}
+test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 8} -setup {
+    catch {destroy .s}
+    set res {}
+    set commandedVar -1
+    set scaleVar 7
+} -body {
+    scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
+    pack .s
+    .s set 10
+    update  ; # -command callback shall fire
+    set res [list [.s get] $commandedVar]
+} -cleanup {
+    destroy .s
+} -result {10 10}
+
 option clear
 
 # cleanup