Fix [69b48f427e]: Test 'textTag-18.1' fails since Win10 Creator Falls Update

1 files changed, 40 insertions, 0 deletions

diff --git a/tests/bind.test b/tests/bind.test
index 5f45ffc..6eb806a 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -6597,6 +6597,46 @@ test bind-33.15 {prefer last in case of homogeneous equal patterns} -setup {
     # must be preferred.
 } -result {last}
 
+test bind-34.1 {-warp works relatively to a window} -setup {
+    toplevel .top
+} -body {
+    # In order to avoid platform-dependent coordinate results due to
+    # decorations and borders, this test warps the pointer twice 
+    # relatively to a window that moved in the meantime, and checks
+    # how much the pointer moved
+    wm geometry .top +200+200
+    update
+    event generate .top <Motion> -x 20 -y 20 -warp 1
+    update idletasks ; # DoWarp is an idle callback
+    set pointerPos1 [winfo pointerxy .t]
+    wm geometry .top +600+600
+    update
+    event generate .top <Motion> -x 20 -y 20 -warp 1
+    update idletasks ; # DoWarp is an idle callback
+    set pointerPos2 [winfo pointerxy .t]
+    # from the first warped position to the second one, the mouse
+    # pointer should have moved the same amount as the window moved
+    set res 1
+    foreach pos1 $pointerPos1 pos2 $pointerPos2 {
+        if {$pos1 != [expr {$pos2 - 400}]} {
+            set res 0
+        }
+    }
+    set res
+} -cleanup {
+    destroy .top
+} -result {1}
+test bind-34.2 {-warp works relatively to the screen} -setup {
+} -body {
+    # Contrary to bind-32.2, we're directly checking screen coordinates
+    event generate {} <Motion> -x 20 -y 20 -warp 1
+    update idletasks ; # DoWarp is an idle callback
+    set res [winfo pointerxy .]
+    event generate {} <Motion> -x 200 -y 200 -warp 1
+    update idletasks ; # DoWarp is an idle callback
+    lappend res {*}[winfo pointerxy .]
+} -cleanup {
+} -result {20 20 200 200}
 
 # cleanup
 cleanupTests